+++ /dev/null
-USING: accessors euler.b-rep euler.modeling euler.operators
-euler.b-rep.examples kernel locals math.vectors.simd.cords
-namespaces sequences tools.test ;
-IN: euler.b-rep.tests
-
-{ double-4{ 0.0 0.0 -1.0 0.0 } }
-[ valid-cube-b-rep edges>> first face-normal ] unit-test
-
-{ double-4{ 0.0 0.0 -1.0 0.0 } -1.0 }
-[ valid-cube-b-rep edges>> first face-plane ] unit-test
-
-{ t } [ 0 multi-ringed-face-cube-b-rep faces>> nth base-face? ] unit-test
-{ t } [ 5 multi-ringed-face-cube-b-rep faces>> nth base-face? ] unit-test
-{ f } [ 6 multi-ringed-face-cube-b-rep faces>> nth base-face? ] unit-test
-
-:: mock-face ( p0 p1 p2 -- edge )
- b-edge new vertex new p0 >>position >>vertex :> e0
- b-edge new vertex new p1 >>position >>vertex :> e1
- b-edge new vertex new p2 >>position >>vertex :> e2
-
- e1 e0 next-edge<<
- e2 e1 next-edge<<
- e0 e2 next-edge<<
-
- e0 ;
-
-{
- double-4{
- 0x1.279a74590331dp-1
- 0x1.279a74590331dp-1
- 0x1.279a74590331dp-1
- 0.0
- }
- -0x1.bb67ae8584cabp1
-} [
- double-4{ 1 0 5 0 }
- double-4{ 0 1 5 0 }
- double-4{ 0 0 6 0 } mock-face face-plane
-] unit-test
-
-V{ t } clone sharpness-stack [
- [ t ] [ get-sharpness ] unit-test
- [ V{ f } ] [ f set-sharpness sharpness-stack get ] unit-test
- [ V{ f t } t ] [ t push-sharpness sharpness-stack get get-sharpness ] unit-test
- [ t V{ f } f ] [ pop-sharpness sharpness-stack get get-sharpness ] unit-test
-] with-variable
-
-{ t } [ valid-cube-b-rep [ edges>> first ] keep is-valid-edge? ] unit-test
-{ f } [ b-edge new valid-cube-b-rep is-valid-edge? ] unit-test
-
-{ t } [
- valid-cube-b-rep edges>>
- [ [ 0 swap nth ] [ 1 swap nth ] bi connecting-edge ]
- [ 0 swap nth ] bi eq?
-] unit-test
-
-{ t } [
- valid-cube-b-rep edges>>
- [ [ 1 swap nth ] [ 0 swap nth ] bi connecting-edge ]
- [ 6 swap nth ] bi eq?
-] unit-test
-
-{ t } [
- valid-cube-b-rep edges>>
- [ [ 0 swap nth ] [ 3 swap nth ] bi connecting-edge ]
- [ 21 swap nth ] bi eq?
-] unit-test
-
-{ f } [
- valid-cube-b-rep edges>>
- [ 0 swap nth ] [ 2 swap nth ] bi connecting-edge
-] unit-test
-
-{ double-4{ 0 0 -1 0 } } [
- [
- { double-4{ 0 0 0 0 } double-4{ 0 1 0 0 } double-4{ 0 2 0 0 } double-4{ 1 1 0 0 } }
- smooth-smooth polygon>double-face face-normal
- ] make-b-rep drop
-] unit-test
+++ /dev/null
-! Copyright (C) 2010 Slava Pestov.
-USING: accessors fry kernel locals sequences sets namespaces
-combinators combinators.short-circuit game.models.half-edge
-math math.vectors math.matrices assocs arrays hashtables ;
-FROM: namespaces => set ;
-IN: euler.b-rep
-
-: >index-hash ( seq -- hash ) H{ } zip-index-as ; inline
-
-TUPLE: b-edge < edge sharpness macro ;
-
-TUPLE: vertex < identity-tuple position edge ;
-
-TUPLE: face < identity-tuple edge next-ring base-face ;
-
-:: (opposite) ( e1 e2 quot: ( edge -- edge' ) -- edge )
- e1 quot call :> e0
- e0 e2 eq? [ e1 ] [ e0 e2 quot (opposite) ] if ;
- inline recursive
-
-: opposite ( edge quot: ( edge -- edge' ) -- edge )
- dupd (opposite) ; inline
-
-: face-ccw ( edge -- edge ) next-edge>> ; inline
-
-: face-cw ( edge -- edge ) [ face-ccw ] opposite ; inline
-
-: vertex-cw ( edge -- edge ) opposite-edge>> next-edge>> ; inline
-
-: vertex-ccw ( edge -- edge ) [ vertex-cw ] opposite ; inline
-
-: base-face? ( face -- ? ) dup base-face>> eq? ; inline
-
-: has-rings? ( face -- ? ) next-ring>> >boolean ; inline
-
-: incident? ( e1 e2 -- ? ) [ vertex>> ] bi@ eq? ; inline
-
-TUPLE: b-rep < identity-tuple faces edges vertices ;
-
-: <b-rep> ( -- b-rep )
- V{ } clone V{ } clone V{ } clone b-rep boa ;
-
-SYMBOL: sharpness-stack
-sharpness-stack [ V{ t } ] initialize
-
-: set-sharpness ( sharp? -- ) >boolean sharpness-stack get set-last ;
-: get-sharpness ( -- sharp? ) sharpness-stack get last ;
-
-: push-sharpness ( sharp? -- ) >boolean sharpness-stack get push ;
-: pop-sharpness ( -- sharp? )
- sharpness-stack get
- dup length 1 = [ first ] [ pop ] if ;
-
-: new-vertex ( position b-rep -- vertex )
- [ f vertex boa dup ] dip vertices>> push ; inline
-
-: new-edge ( b-rep -- edge )
- [ b-edge new get-sharpness >>sharpness dup ] dip edges>> push ; inline
-
-: new-face ( b-rep -- face )
- [ face new dup ] dip faces>> push ; inline
-
-: delete-vertex ( vertex b-rep -- )
- vertices>> remove! drop ; inline
-
-: delete-edge ( edge b-rep -- )
- edges>> remove! drop ; inline
-
-: delete-face ( face b-rep -- )
- faces>> remove! drop ; inline
-
-: add-ring ( ring base-face -- )
- [ >>base-face drop ]
- [ next-ring>> >>next-ring drop ]
- [ swap >>next-ring drop ]
- 2tri ;
-
-: delete-ring ( ring base-face -- )
- 2dup next-ring>> eq?
- [ [ next-ring>> ] dip next-ring<< ]
- [ next-ring>> delete-ring ]
- if ;
-
-: vertex-pos ( edge -- pos )
- vertex>> position>> ; inline
-
-: same-edge? ( e1 e2 -- ? )
- { [ eq? ] [ opposite-edge>> eq? ] } 2|| ;
-
-: same-face? ( e1 e2 -- ? )
- [ face>> ] bi@ eq? ;
-
-: edge-direction ( edge -- v )
- [ face-ccw ] keep [ vertex-pos ] bi@ v- ;
-
-: normal ( v0 v1 v2 -- v )
- [ drop v- ] [ [ drop ] 2dip v- ] 3bi cross ;
-
-ERROR: all-points-colinear ;
-
-: face-normal ( edge -- n )
- face-edges
- [
- dup face-ccw dup face-ccw
- [ vertex-pos ] tri@ normal
- ] map
- [ [ zero? ] all? not ] find nip
- [ normalize ] [ all-points-colinear ] if* ;
-
-: (face-plane-dist) ( normal edge -- d )
- vertex-pos v. neg ; inline
-
-: face-plane-dist ( edge -- d )
- [ face-normal ] [ (face-plane-dist) ] bi ; inline
-
-: face-plane ( edge -- n d )
- [ face-normal dup ] [ (face-plane-dist) ] bi ; inline
-
-: face-midpoint ( edge -- v )
- face-edges
- [ [ vertex-pos ] [ v+ ] map-reduce ] [ length ] bi v/n ;
-
-: clear-b-rep ( b-rep -- )
- [ faces>> delete-all ]
- [ edges>> delete-all ]
- [ vertices>> delete-all ]
- tri ;
-
-: connect-opposite-edges ( b-rep -- )
- edges>>
- [ [ [ next-edge>> vertex>> ] [ vertex>> 2array ] [ ] tri ] H{ } map>assoc ]
- [ swap '[ [ vertex>> ] [ next-edge>> vertex>> 2array _ at ] [ opposite-edge<< ] tri ] each ] bi ;
-
-: connect-faces ( b-rep -- )
- edges>> [ dup face>> edge<< ] each ;
-
-: connect-vertices ( b-rep -- )
- edges>> [ dup vertex>> edge<< ] each ;
-
-: finish-b-rep ( b-rep -- )
- [ connect-faces ] [ connect-vertices ] bi ;
-
-: characteristic ( b-rep -- n )
- ! Assumes b-rep is connected and all faces are convex
- [ vertices>> length ]
- [ edges>> length 2 / ]
- [ faces>> [ base-face? ] count ] tri
- [ - ] dip + ;
-
-: genus ( b-rep -- n )
- ! Assumes b-rep is connected and all faces are convex
- characteristic 2 swap - 2 / ;
-
-SYMBOLS: live-vertices live-edges live-faces ;
-
-ERROR: dead-vertex vertex ;
-
-: check-live-vertex ( vertex -- )
- dup live-vertices get in? [ drop ] [ dead-vertex ] if ;
-
-ERROR: dead-edge edge ;
-
-: check-live-edge ( edge -- )
- dup live-edges get in? [ drop ] [ dead-edge ] if ;
-
-ERROR: dead-face face ;
-
-: check-live-face ( face -- )
- dup live-faces get in? [ drop ] [ dead-face ] if ;
-
-: check-vertex ( vertex -- )
- [ edge>> check-live-edge ]
- [ dup edge>> [ vertex>> assert= ] with each-vertex-edge ]
- bi ;
-
-: check-edge ( edge -- )
- {
- [ vertex>> check-live-vertex ]
- [ opposite-edge>> check-live-edge ]
- [ face>> check-live-face ]
- [ dup opposite-edge>> opposite-edge>> assert= ]
- } cleave ;
-
-: check-face ( face -- )
- [ edge>> check-live-edge ]
- [ dup edge>> [ face>> assert= ] with each-face-edge ]
- bi ;
-
-: check-ring ( base-face face -- )
- [ check-face ] [ base-face>> assert= ] bi ;
-
-: check-base-face ( face -- )
- [ check-face ]
- [ dup [ next-ring>> ] follow rest [ check-ring ] with each ] bi ;
-
-: check-b-rep ( b-rep -- )
- [
- [
- [ vertices>> fast-set live-vertices set ]
- [ edges>> fast-set live-edges set ]
- [ faces>> fast-set live-faces set ] tri
- ]
- [
- [ vertices>> [ check-vertex ] each ]
- [ edges>> [ check-edge ] each ]
- [ faces>> [ base-face? ] filter [ check-base-face ] each ] tri
- ] bi
- ] with-scope ;
-
-: empty-b-rep? ( b-rep -- ? )
- [ faces>> ] [ edges>> ] [ vertices>> ] tri
- [ empty? ] tri@ and and ;
-
-ERROR: b-rep-not-empty b-rep ;
-
-: assert-empty-b-rep ( b-rep -- )
- dup empty-b-rep? [ drop ] [ b-rep-not-empty ] if ;
-
-: is-valid-edge? ( e brep -- ? )
- edges>> member? ; inline
-
-: edge-endpoints ( edge -- from to )
- [ vertex>> position>> ]
- [ opposite-edge>> vertex>> position>> ] bi ; inline
-
-:: connecting-edge ( e0 e1 -- edge/f )
- e1 vertex>> :> target-vertex
- e0 vertex>> target-vertex eq? [ f ] [
- f e0 [| ret edge |
- edge opposite-edge>> vertex>> target-vertex eq?
- [ edge edge f ]
- [ f edge vertex-cw dup e0 eq? not ] if
- ] loop drop
- ] if ;
+++ /dev/null
-USING: accessors assocs euler.b-rep game.models.half-edge
-kernel locals math.vectors.simd.cords sequences ;
-IN: euler.b-rep.examples
-
-CONSTANT: valid-cube-b-rep
- T{ b-rep
- { faces {
- T{ face { edge 0 } { next-ring f } { base-face 0 } }
- T{ face { edge 4 } { next-ring f } { base-face 1 } }
- T{ face { edge 8 } { next-ring f } { base-face 2 } }
- T{ face { edge 12 } { next-ring f } { base-face 3 } }
- T{ face { edge 16 } { next-ring f } { base-face 4 } }
- T{ face { edge 20 } { next-ring f } { base-face 5 } }
- } }
- { edges {
- T{ b-edge { face 0 } { vertex 0 } { opposite-edge 6 } { next-edge 1 } }
- T{ b-edge { face 0 } { vertex 1 } { opposite-edge 19 } { next-edge 2 } }
- T{ b-edge { face 0 } { vertex 3 } { opposite-edge 12 } { next-edge 3 } }
- T{ b-edge { face 0 } { vertex 2 } { opposite-edge 21 } { next-edge 0 } }
-
- T{ b-edge { face 1 } { vertex 4 } { opposite-edge 10 } { next-edge 5 } }
- T{ b-edge { face 1 } { vertex 5 } { opposite-edge 16 } { next-edge 6 } }
- T{ b-edge { face 1 } { vertex 1 } { opposite-edge 0 } { next-edge 7 } }
- T{ b-edge { face 1 } { vertex 0 } { opposite-edge 20 } { next-edge 4 } }
-
- T{ b-edge { face 2 } { vertex 6 } { opposite-edge 14 } { next-edge 9 } }
- T{ b-edge { face 2 } { vertex 7 } { opposite-edge 17 } { next-edge 10 } }
- T{ b-edge { face 2 } { vertex 5 } { opposite-edge 4 } { next-edge 11 } }
- T{ b-edge { face 2 } { vertex 4 } { opposite-edge 23 } { next-edge 8 } }
-
- T{ b-edge { face 3 } { vertex 2 } { opposite-edge 2 } { next-edge 13 } }
- T{ b-edge { face 3 } { vertex 3 } { opposite-edge 18 } { next-edge 14 } }
- T{ b-edge { face 3 } { vertex 7 } { opposite-edge 8 } { next-edge 15 } }
- T{ b-edge { face 3 } { vertex 6 } { opposite-edge 22 } { next-edge 12 } }
-
- T{ b-edge { face 4 } { vertex 1 } { opposite-edge 5 } { next-edge 17 } }
- T{ b-edge { face 4 } { vertex 5 } { opposite-edge 9 } { next-edge 18 } }
- T{ b-edge { face 4 } { vertex 7 } { opposite-edge 13 } { next-edge 19 } }
- T{ b-edge { face 4 } { vertex 3 } { opposite-edge 1 } { next-edge 16 } }
-
- T{ b-edge { face 5 } { vertex 4 } { opposite-edge 7 } { next-edge 21 } }
- T{ b-edge { face 5 } { vertex 0 } { opposite-edge 3 } { next-edge 22 } }
- T{ b-edge { face 5 } { vertex 2 } { opposite-edge 15 } { next-edge 23 } }
- T{ b-edge { face 5 } { vertex 6 } { opposite-edge 11 } { next-edge 20 } }
- } }
- { vertices {
- T{ vertex { position double-4{ -1.0 -1.0 -1.0 0.0 } } { edge 0 } }
- T{ vertex { position double-4{ -1.0 1.0 -1.0 0.0 } } { edge 1 } }
- T{ vertex { position double-4{ 1.0 -1.0 -1.0 0.0 } } { edge 3 } }
- T{ vertex { position double-4{ 1.0 1.0 -1.0 0.0 } } { edge 2 } }
- T{ vertex { position double-4{ -1.0 -1.0 1.0 0.0 } } { edge 4 } }
- T{ vertex { position double-4{ -1.0 1.0 1.0 0.0 } } { edge 5 } }
- T{ vertex { position double-4{ 1.0 -1.0 1.0 0.0 } } { edge 8 } }
- T{ vertex { position double-4{ 1.0 1.0 1.0 0.0 } } { edge 9 } }
- } }
- }
-
-CONSTANT: missing-face-cube-b-rep
- T{ b-rep
- { faces {
- T{ face { edge 0 } { next-ring f } { base-face 0 } }
- T{ face { edge 4 } { next-ring f } { base-face 1 } }
- T{ face { edge 8 } { next-ring f } { base-face 2 } }
- T{ face { edge 12 } { next-ring f } { base-face 3 } }
- T{ face { edge 16 } { next-ring f } { base-face 4 } }
- } }
- { edges {
- T{ b-edge { face 0 } { vertex 0 } { opposite-edge 6 } { next-edge 1 } }
- T{ b-edge { face 0 } { vertex 1 } { opposite-edge 19 } { next-edge 2 } }
- T{ b-edge { face 0 } { vertex 3 } { opposite-edge 12 } { next-edge 3 } }
- T{ b-edge { face 0 } { vertex 2 } { opposite-edge f } { next-edge 0 } }
-
- T{ b-edge { face 1 } { vertex 4 } { opposite-edge 10 } { next-edge 5 } }
- T{ b-edge { face 1 } { vertex 5 } { opposite-edge 16 } { next-edge 6 } }
- T{ b-edge { face 1 } { vertex 1 } { opposite-edge 0 } { next-edge 7 } }
- T{ b-edge { face 1 } { vertex 0 } { opposite-edge f } { next-edge 4 } }
-
- T{ b-edge { face 2 } { vertex 6 } { opposite-edge 14 } { next-edge 9 } }
- T{ b-edge { face 2 } { vertex 7 } { opposite-edge 17 } { next-edge 10 } }
- T{ b-edge { face 2 } { vertex 5 } { opposite-edge 4 } { next-edge 11 } }
- T{ b-edge { face 2 } { vertex 4 } { opposite-edge f } { next-edge 8 } }
-
- T{ b-edge { face 3 } { vertex 2 } { opposite-edge 2 } { next-edge 13 } }
- T{ b-edge { face 3 } { vertex 3 } { opposite-edge f } { next-edge 14 } }
- T{ b-edge { face 3 } { vertex 7 } { opposite-edge 8 } { next-edge 15 } }
- T{ b-edge { face 3 } { vertex 6 } { opposite-edge 18 } { next-edge 12 } }
-
- T{ b-edge { face 4 } { vertex 1 } { opposite-edge 5 } { next-edge 17 } }
- T{ b-edge { face 4 } { vertex 5 } { opposite-edge 9 } { next-edge 18 } }
- T{ b-edge { face 4 } { vertex 7 } { opposite-edge 13 } { next-edge 19 } }
- T{ b-edge { face 4 } { vertex 3 } { opposite-edge 1 } { next-edge 16 } }
- } }
- { vertices {
- T{ vertex { position double-4{ -1.0 -1.0 -1.0 0.0 } } { edge 0 } }
- T{ vertex { position double-4{ -1.0 1.0 -1.0 0.0 } } { edge 1 } }
- T{ vertex { position double-4{ 1.0 1.0 -1.0 0.0 } } { edge 3 } }
- T{ vertex { position double-4{ 1.0 1.0 -1.0 0.0 } } { edge 2 } }
- T{ vertex { position double-4{ -1.0 -1.0 1.0 0.0 } } { edge 4 } }
- T{ vertex { position double-4{ -1.0 1.0 1.0 0.0 } } { edge 5 } }
- T{ vertex { position double-4{ 1.0 1.0 1.0 0.0 } } { edge 8 } }
- T{ vertex { position double-4{ 1.0 1.0 1.0 0.0 } } { edge 9 } }
- } }
- }
-
-CONSTANT: non-quad-face-cube-b-rep
- T{ b-rep
- { faces {
- T{ face { edge 0 } { next-ring f } { base-face 0 } }
- T{ face { edge 4 } { next-ring f } { base-face 1 } }
- T{ face { edge 8 } { next-ring f } { base-face 2 } }
- T{ face { edge 12 } { next-ring f } { base-face 3 } }
- T{ face { edge 18 } { next-ring f } { base-face 4 } }
- } }
- { edges {
- T{ b-edge { face 0 } { vertex 0 } { opposite-edge 6 } { next-edge 1 } }
- T{ b-edge { face 0 } { vertex 1 } { opposite-edge 19 } { next-edge 2 } }
- T{ b-edge { face 0 } { vertex 3 } { opposite-edge 12 } { next-edge 3 } }
- T{ b-edge { face 0 } { vertex 2 } { opposite-edge 19 } { next-edge 0 } }
-
- T{ b-edge { face 1 } { vertex 4 } { opposite-edge 10 } { next-edge 5 } }
- T{ b-edge { face 1 } { vertex 5 } { opposite-edge 16 } { next-edge 6 } }
- T{ b-edge { face 1 } { vertex 1 } { opposite-edge 0 } { next-edge 7 } }
- T{ b-edge { face 1 } { vertex 0 } { opposite-edge 18 } { next-edge 4 } }
-
- T{ b-edge { face 2 } { vertex 6 } { opposite-edge 14 } { next-edge 9 } }
- T{ b-edge { face 2 } { vertex 7 } { opposite-edge 17 } { next-edge 10 } }
- T{ b-edge { face 2 } { vertex 5 } { opposite-edge 4 } { next-edge 11 } }
- T{ b-edge { face 2 } { vertex 4 } { opposite-edge 21 } { next-edge 8 } }
-
- T{ b-edge { face 3 } { vertex 2 } { opposite-edge 2 } { next-edge 13 } }
- T{ b-edge { face 3 } { vertex 3 } { opposite-edge 20 } { next-edge 16 } }
- T{ b-edge { face 3 } { vertex 7 } { opposite-edge 8 } { next-edge 15 } }
- T{ b-edge { face 3 } { vertex 6 } { opposite-edge 18 } { next-edge 12 } }
- T{ b-edge { face 3 } { vertex 1 } { opposite-edge 5 } { next-edge 17 } }
- T{ b-edge { face 3 } { vertex 5 } { opposite-edge 9 } { next-edge 14 } }
-
- T{ b-edge { face 4 } { vertex 4 } { opposite-edge 7 } { next-edge 19 } }
- T{ b-edge { face 4 } { vertex 0 } { opposite-edge 3 } { next-edge 20 } }
- T{ b-edge { face 4 } { vertex 2 } { opposite-edge 15 } { next-edge 21 } }
- T{ b-edge { face 4 } { vertex 6 } { opposite-edge 11 } { next-edge 18 } }
- } }
- { vertices {
- T{ vertex { position double-4{ -1.0 -1.0 -1.0 0.0 } } { edge 0 } }
- T{ vertex { position double-4{ -1.0 1.0 -1.0 0.0 } } { edge 1 } }
- T{ vertex { position double-4{ 1.0 1.0 -1.0 0.0 } } { edge 3 } }
- T{ vertex { position double-4{ 1.0 1.0 -1.0 0.0 } } { edge 2 } }
- T{ vertex { position double-4{ -1.0 -1.0 1.0 0.0 } } { edge 4 } }
- T{ vertex { position double-4{ -1.0 1.0 1.0 0.0 } } { edge 5 } }
- T{ vertex { position double-4{ 1.0 1.0 1.0 0.0 } } { edge 8 } }
- T{ vertex { position double-4{ 1.0 1.0 1.0 0.0 } } { edge 9 } }
- } }
- }
-
-CONSTANT: multi-ringed-face-cube-b-rep
- T{ b-rep
- { faces {
- T{ face { edge 0 } { next-ring f } { base-face 0 } }
- T{ face { edge 4 } { next-ring f } { base-face 1 } }
- T{ face { edge 8 } { next-ring f } { base-face 2 } }
- T{ face { edge 12 } { next-ring f } { base-face 3 } }
- T{ face { edge 16 } { next-ring f } { base-face 4 } }
- T{ face { edge 20 } { next-ring 6 } { base-face 5 } }
- T{ face { edge 24 } { next-ring f } { base-face 5 } }
- } }
- { edges {
- T{ b-edge { face 0 } { vertex 0 } { opposite-edge 6 } { next-edge 1 } }
- T{ b-edge { face 0 } { vertex 1 } { opposite-edge 19 } { next-edge 2 } }
- T{ b-edge { face 0 } { vertex 3 } { opposite-edge 12 } { next-edge 3 } }
- T{ b-edge { face 0 } { vertex 2 } { opposite-edge 21 } { next-edge 0 } }
-
- T{ b-edge { face 1 } { vertex 4 } { opposite-edge 10 } { next-edge 5 } }
- T{ b-edge { face 1 } { vertex 5 } { opposite-edge 16 } { next-edge 6 } }
- T{ b-edge { face 1 } { vertex 1 } { opposite-edge 0 } { next-edge 7 } }
- T{ b-edge { face 1 } { vertex 0 } { opposite-edge 20 } { next-edge 4 } }
-
- T{ b-edge { face 2 } { vertex 6 } { opposite-edge 14 } { next-edge 9 } }
- T{ b-edge { face 2 } { vertex 7 } { opposite-edge 17 } { next-edge 10 } }
- T{ b-edge { face 2 } { vertex 5 } { opposite-edge 4 } { next-edge 11 } }
- T{ b-edge { face 2 } { vertex 4 } { opposite-edge 23 } { next-edge 8 } }
-
- T{ b-edge { face 3 } { vertex 2 } { opposite-edge 2 } { next-edge 13 } }
- T{ b-edge { face 3 } { vertex 3 } { opposite-edge 22 } { next-edge 14 } }
- T{ b-edge { face 3 } { vertex 7 } { opposite-edge 8 } { next-edge 15 } }
- T{ b-edge { face 3 } { vertex 6 } { opposite-edge 18 } { next-edge 12 } }
-
- T{ b-edge { face 4 } { vertex 1 } { opposite-edge 5 } { next-edge 17 } }
- T{ b-edge { face 4 } { vertex 5 } { opposite-edge 9 } { next-edge 18 } }
- T{ b-edge { face 4 } { vertex 7 } { opposite-edge 13 } { next-edge 19 } }
- T{ b-edge { face 4 } { vertex 3 } { opposite-edge 1 } { next-edge 16 } }
-
- T{ b-edge { face 5 } { vertex 4 } { opposite-edge 7 } { next-edge 21 } }
- T{ b-edge { face 5 } { vertex 0 } { opposite-edge 3 } { next-edge 22 } }
- T{ b-edge { face 5 } { vertex 2 } { opposite-edge 15 } { next-edge 23 } }
- T{ b-edge { face 5 } { vertex 6 } { opposite-edge 11 } { next-edge 20 } }
-
- T{ b-edge { face 6 } { vertex 8 } { opposite-edge f } { next-edge 25 } }
- T{ b-edge { face 6 } { vertex 9 } { opposite-edge f } { next-edge 26 } }
- T{ b-edge { face 6 } { vertex 10 } { opposite-edge f } { next-edge 27 } }
- T{ b-edge { face 6 } { vertex 11 } { opposite-edge f } { next-edge 24 } }
- } }
- { vertices {
- T{ vertex { position double-4{ -1.0 -1.0 -1.0 0.0 } } { edge 0 } }
- T{ vertex { position double-4{ -1.0 1.0 -1.0 0.0 } } { edge 1 } }
- T{ vertex { position double-4{ 1.0 1.0 -1.0 0.0 } } { edge 3 } }
- T{ vertex { position double-4{ 1.0 1.0 -1.0 0.0 } } { edge 2 } }
- T{ vertex { position double-4{ -1.0 -1.0 1.0 0.0 } } { edge 4 } }
- T{ vertex { position double-4{ -1.0 1.0 1.0 0.0 } } { edge 5 } }
- T{ vertex { position double-4{ 1.0 1.0 1.0 0.0 } } { edge 8 } }
- T{ vertex { position double-4{ 1.0 1.0 1.0 0.0 } } { edge 9 } }
-
- T{ vertex { position double-4{ -1.0 -1.0 0.5 0.0 } } { edge 24 } }
- T{ vertex { position double-4{ -1.0 -1.0 -0.5 0.0 } } { edge 25 } }
- T{ vertex { position double-4{ 1.0 1.0 -0.5 0.0 } } { edge 26 } }
- T{ vertex { position double-4{ 1.0 1.0 0.5 0.0 } } { edge 27 } }
- } }
- }
-
-CONSTANT: valid-multi-valence-b-rep
- T{ b-rep
- { edges {
- T{ b-edge { face 0 } { vertex 23 } { opposite-edge 12 } { next-edge 1 } }
- T{ b-edge { face 0 } { vertex 22 } { opposite-edge 8 } { next-edge 2 } }
- T{ b-edge { face 0 } { vertex 20 } { opposite-edge 4 } { next-edge 3 } }
- T{ b-edge { face 0 } { vertex 21 } { opposite-edge 16 } { next-edge 0 } }
-
- T{ b-edge { face 1 } { vertex 21 } { opposite-edge 2 } { next-edge 5 } }
- T{ b-edge { face 1 } { vertex 20 } { opposite-edge 11 } { next-edge 6 } }
- T{ b-edge { face 1 } { vertex 16 } { opposite-edge 20 } { next-edge 7 } }
- T{ b-edge { face 1 } { vertex 17 } { opposite-edge 17 } { next-edge 4 } }
-
- T{ b-edge { face 2 } { vertex 20 } { opposite-edge 1 } { next-edge 9 } }
- T{ b-edge { face 2 } { vertex 22 } { opposite-edge 15 } { next-edge 10 } }
- T{ b-edge { face 2 } { vertex 18 } { opposite-edge 24 } { next-edge 11 } }
- T{ b-edge { face 2 } { vertex 16 } { opposite-edge 5 } { next-edge 8 } }
-
- T{ b-edge { face 3 } { vertex 22 } { opposite-edge 0 } { next-edge 13 } }
- T{ b-edge { face 3 } { vertex 23 } { opposite-edge 19 } { next-edge 14 } }
- T{ b-edge { face 3 } { vertex 19 } { opposite-edge 28 } { next-edge 15 } }
- T{ b-edge { face 3 } { vertex 18 } { opposite-edge 9 } { next-edge 12 } }
-
- T{ b-edge { face 4 } { vertex 23 } { opposite-edge 3 } { next-edge 17 } }
- T{ b-edge { face 4 } { vertex 21 } { opposite-edge 7 } { next-edge 18 } }
- T{ b-edge { face 4 } { vertex 17 } { opposite-edge 32 } { next-edge 19 } }
- T{ b-edge { face 4 } { vertex 19 } { opposite-edge 13 } { next-edge 16 } }
-
- T{ b-edge { face 5 } { vertex 17 } { opposite-edge 6 } { next-edge 21 } }
- T{ b-edge { face 5 } { vertex 16 } { opposite-edge 27 } { next-edge 22 } }
- T{ b-edge { face 5 } { vertex 0 } { opposite-edge 36 } { next-edge 23 } }
- T{ b-edge { face 5 } { vertex 1 } { opposite-edge 33 } { next-edge 20 } }
-
- T{ b-edge { face 6 } { vertex 16 } { opposite-edge 10 } { next-edge 25 } }
- T{ b-edge { face 6 } { vertex 18 } { opposite-edge 31 } { next-edge 26 } }
- T{ b-edge { face 6 } { vertex 2 } { opposite-edge 44 } { next-edge 27 } }
- T{ b-edge { face 6 } { vertex 0 } { opposite-edge 21 } { next-edge 24 } }
-
- T{ b-edge { face 7 } { vertex 18 } { opposite-edge 14 } { next-edge 29 } }
- T{ b-edge { face 7 } { vertex 19 } { opposite-edge 35 } { next-edge 30 } }
- T{ b-edge { face 7 } { vertex 3 } { opposite-edge 52 } { next-edge 31 } }
- T{ b-edge { face 7 } { vertex 2 } { opposite-edge 25 } { next-edge 28 } }
-
- T{ b-edge { face 8 } { vertex 19 } { opposite-edge 18 } { next-edge 33 } }
- T{ b-edge { face 8 } { vertex 17 } { opposite-edge 23 } { next-edge 34 } }
- T{ b-edge { face 8 } { vertex 1 } { opposite-edge 60 } { next-edge 35 } }
- T{ b-edge { face 8 } { vertex 3 } { opposite-edge 29 } { next-edge 32 } }
-
- T{ b-edge { face 9 } { vertex 1 } { opposite-edge 22 } { next-edge 37 } }
- T{ b-edge { face 9 } { vertex 0 } { opposite-edge 43 } { next-edge 38 } }
- T{ b-edge { face 9 } { vertex 8 } { opposite-edge 68 } { next-edge 39 } }
- T{ b-edge { face 9 } { vertex 9 } { opposite-edge 65 } { next-edge 36 } }
-
- T{ b-edge { face 10 } { vertex 0 } { opposite-edge 47 } { next-edge 41 } }
- T{ b-edge { face 10 } { vertex 10 } { opposite-edge 73 } { next-edge 42 } }
- T{ b-edge { face 10 } { vertex 24 } { opposite-edge 72 } { next-edge 43 } }
- T{ b-edge { face 10 } { vertex 8 } { opposite-edge 37 } { next-edge 40 } }
-
- T{ b-edge { face 11 } { vertex 0 } { opposite-edge 26 } { next-edge 45 } }
- T{ b-edge { face 11 } { vertex 2 } { opposite-edge 51 } { next-edge 46 } }
- T{ b-edge { face 11 } { vertex 12 } { opposite-edge 76 } { next-edge 47 } }
- T{ b-edge { face 11 } { vertex 10 } { opposite-edge 40 } { next-edge 44 } }
-
- T{ b-edge { face 12 } { vertex 2 } { opposite-edge 55 } { next-edge 49 } }
- T{ b-edge { face 12 } { vertex 14 } { opposite-edge 81 } { next-edge 50 } }
- T{ b-edge { face 12 } { vertex 26 } { opposite-edge 80 } { next-edge 51 } }
- T{ b-edge { face 12 } { vertex 12 } { opposite-edge 45 } { next-edge 48 } }
-
- T{ b-edge { face 13 } { vertex 2 } { opposite-edge 30 } { next-edge 53 } }
- T{ b-edge { face 13 } { vertex 3 } { opposite-edge 59 } { next-edge 54 } }
- T{ b-edge { face 13 } { vertex 15 } { opposite-edge 84 } { next-edge 55 } }
- T{ b-edge { face 13 } { vertex 14 } { opposite-edge 48 } { next-edge 52 } }
-
- T{ b-edge { face 14 } { vertex 3 } { opposite-edge 63 } { next-edge 57 } }
- T{ b-edge { face 14 } { vertex 13 } { opposite-edge 89 } { next-edge 58 } }
- T{ b-edge { face 14 } { vertex 27 } { opposite-edge 88 } { next-edge 59 } }
- T{ b-edge { face 14 } { vertex 15 } { opposite-edge 53 } { next-edge 56 } }
-
- T{ b-edge { face 15 } { vertex 3 } { opposite-edge 34 } { next-edge 61 } }
- T{ b-edge { face 15 } { vertex 1 } { opposite-edge 64 } { next-edge 62 } }
- T{ b-edge { face 15 } { vertex 11 } { opposite-edge 92 } { next-edge 63 } }
- T{ b-edge { face 15 } { vertex 13 } { opposite-edge 56 } { next-edge 60 } }
-
- T{ b-edge { face 16 } { vertex 11 } { opposite-edge 61 } { next-edge 65 } }
- T{ b-edge { face 16 } { vertex 1 } { opposite-edge 39 } { next-edge 66 } }
- T{ b-edge { face 16 } { vertex 9 } { opposite-edge 97 } { next-edge 67 } }
- T{ b-edge { face 16 } { vertex 25 } { opposite-edge 96 } { next-edge 64 } }
-
- T{ b-edge { face 17 } { vertex 9 } { opposite-edge 38 } { next-edge 69 } }
- T{ b-edge { face 17 } { vertex 8 } { opposite-edge 75 } { next-edge 70 } }
- T{ b-edge { face 17 } { vertex 4 } { opposite-edge 102 } { next-edge 71 } }
- T{ b-edge { face 17 } { vertex 5 } { opposite-edge 98 } { next-edge 68 } }
-
- T{ b-edge { face 18 } { vertex 8 } { opposite-edge 42 } { next-edge 73 } }
- T{ b-edge { face 18 } { vertex 24 } { opposite-edge 41 } { next-edge 74 } }
- T{ b-edge { face 18 } { vertex 10 } { opposite-edge 79 } { next-edge 75 } }
- T{ b-edge { face 18 } { vertex 4 } { opposite-edge 69 } { next-edge 72 } }
-
- T{ b-edge { face 19 } { vertex 10 } { opposite-edge 46 } { next-edge 77 } }
- T{ b-edge { face 19 } { vertex 12 } { opposite-edge 83 } { next-edge 78 } }
- T{ b-edge { face 19 } { vertex 6 } { opposite-edge 103 } { next-edge 79 } }
- T{ b-edge { face 19 } { vertex 4 } { opposite-edge 74 } { next-edge 76 } }
-
- T{ b-edge { face 20 } { vertex 12 } { opposite-edge 50 } { next-edge 81 } }
- T{ b-edge { face 20 } { vertex 26 } { opposite-edge 49 } { next-edge 82 } }
- T{ b-edge { face 20 } { vertex 14 } { opposite-edge 87 } { next-edge 83 } }
- T{ b-edge { face 20 } { vertex 6 } { opposite-edge 77 } { next-edge 80 } }
-
- T{ b-edge { face 21 } { vertex 14 } { opposite-edge 54 } { next-edge 85 } }
- T{ b-edge { face 21 } { vertex 15 } { opposite-edge 91 } { next-edge 86 } }
- T{ b-edge { face 21 } { vertex 7 } { opposite-edge 100 } { next-edge 87 } }
- T{ b-edge { face 21 } { vertex 6 } { opposite-edge 82 } { next-edge 84 } }
-
- T{ b-edge { face 22 } { vertex 15 } { opposite-edge 58 } { next-edge 89 } }
- T{ b-edge { face 22 } { vertex 27 } { opposite-edge 57 } { next-edge 90 } }
- T{ b-edge { face 22 } { vertex 13 } { opposite-edge 95 } { next-edge 91 } }
- T{ b-edge { face 22 } { vertex 7 } { opposite-edge 85 } { next-edge 88 } }
-
- T{ b-edge { face 23 } { vertex 13 } { opposite-edge 62 } { next-edge 93 } }
- T{ b-edge { face 23 } { vertex 11 } { opposite-edge 99 } { next-edge 94 } }
- T{ b-edge { face 23 } { vertex 5 } { opposite-edge 101 } { next-edge 95 } }
- T{ b-edge { face 23 } { vertex 7 } { opposite-edge 90 } { next-edge 92 } }
-
- T{ b-edge { face 24 } { vertex 11 } { opposite-edge 67 } { next-edge 97 } }
- T{ b-edge { face 24 } { vertex 25 } { opposite-edge 66 } { next-edge 98 } }
- T{ b-edge { face 24 } { vertex 9 } { opposite-edge 71 } { next-edge 99 } }
- T{ b-edge { face 24 } { vertex 5 } { opposite-edge 93 } { next-edge 96 } }
-
- T{ b-edge { face 25 } { vertex 6 } { opposite-edge 86 } { next-edge 101 } }
- T{ b-edge { face 25 } { vertex 7 } { opposite-edge 94 } { next-edge 102 } }
- T{ b-edge { face 25 } { vertex 5 } { opposite-edge 70 } { next-edge 103 } }
- T{ b-edge { face 25 } { vertex 4 } { opposite-edge 78 } { next-edge 100 } }
- } }
- { vertices {
- T{ vertex { position double-4{ 1.0 1.0 1.0 0.0 } } { edge 37 } }
- T{ vertex { position double-4{ 1.0 1.0 -1.0 0.0 } } { edge 36 } }
- T{ vertex { position double-4{ 1.0 -1.0 1.0 0.0 } } { edge 52 } }
- T{ vertex { position double-4{ 1.0 -1.0 -1.0 0.0 } } { edge 53 } }
-
- T{ vertex { position double-4{ 3.0 1.0 1.0 0.0 } } { edge 70 } }
- T{ vertex { position double-4{ 3.0 1.0 -1.0 0.0 } } { edge 71 } }
- T{ vertex { position double-4{ 3.0 -1.0 1.0 0.0 } } { edge 87 } }
- T{ vertex { position double-4{ 3.0 -1.0 -1.0 0.0 } } { edge 86 } }
-
- T{ vertex { position double-4{ 2.0 2.0 1.0 0.0 } } { edge 38 } }
- T{ vertex { position double-4{ 2.0 2.0 -1.0 0.0 } } { edge 39 } }
- T{ vertex { position double-4{ 2.0 1.0 2.0 0.0 } } { edge 47 } }
- T{ vertex { position double-4{ 2.0 1.0 -2.0 0.0 } } { edge 62 } }
-
- T{ vertex { position double-4{ 2.0 -1.0 2.0 0.0 } } { edge 51 } }
- T{ vertex { position double-4{ 2.0 -1.0 -2.0 0.0 } } { edge 57 } }
- T{ vertex { position double-4{ 2.0 -2.0 1.0 0.0 } } { edge 55 } }
- T{ vertex { position double-4{ 2.0 -2.0 -1.0 0.0 } } { edge 54 } }
-
- T{ vertex { position double-4{ -1.0 1.0 1.0 0.0 } } { edge 6 } }
- T{ vertex { position double-4{ -1.0 1.0 -1.0 0.0 } } { edge 7 } }
- T{ vertex { position double-4{ -1.0 -1.0 1.0 0.0 } } { edge 15 } }
- T{ vertex { position double-4{ -1.0 -1.0 -1.0 0.0 } } { edge 14 } }
-
- T{ vertex { position double-4{ -2.0 1.0 1.0 0.0 } } { edge 2 } }
- T{ vertex { position double-4{ -2.0 1.0 -1.0 0.0 } } { edge 3 } }
- T{ vertex { position double-4{ -2.0 -1.0 1.0 0.0 } } { edge 1 } }
- T{ vertex { position double-4{ -2.0 -1.0 -1.0 0.0 } } { edge 0 } }
-
- T{ vertex { position double-4{ 2.0 2.0 2.0 0.0 } } { edge 42 } }
- T{ vertex { position double-4{ 2.0 2.0 -2.0 0.0 } } { edge 67 } }
- T{ vertex { position double-4{ 2.0 -2.0 2.0 0.0 } } { edge 50 } }
- T{ vertex { position double-4{ 2.0 -2.0 -2.0 0.0 } } { edge 58 } }
- } }
- { faces {
- T{ face { edge 0 } { next-ring f } { base-face 0 } }
- T{ face { edge 4 } { next-ring f } { base-face 1 } }
- T{ face { edge 8 } { next-ring f } { base-face 2 } }
- T{ face { edge 12 } { next-ring f } { base-face 3 } }
- T{ face { edge 16 } { next-ring f } { base-face 4 } }
- T{ face { edge 20 } { next-ring f } { base-face 5 } }
- T{ face { edge 24 } { next-ring f } { base-face 6 } }
- T{ face { edge 28 } { next-ring f } { base-face 7 } }
- T{ face { edge 32 } { next-ring f } { base-face 8 } }
- T{ face { edge 36 } { next-ring f } { base-face 9 } }
- T{ face { edge 40 } { next-ring f } { base-face 10 } }
- T{ face { edge 44 } { next-ring f } { base-face 11 } }
- T{ face { edge 48 } { next-ring f } { base-face 12 } }
- T{ face { edge 52 } { next-ring f } { base-face 13 } }
- T{ face { edge 56 } { next-ring f } { base-face 14 } }
- T{ face { edge 60 } { next-ring f } { base-face 15 } }
- T{ face { edge 64 } { next-ring f } { base-face 16 } }
- T{ face { edge 68 } { next-ring f } { base-face 17 } }
- T{ face { edge 72 } { next-ring f } { base-face 18 } }
- T{ face { edge 76 } { next-ring f } { base-face 19 } }
- T{ face { edge 80 } { next-ring f } { base-face 20 } }
- T{ face { edge 84 } { next-ring f } { base-face 21 } }
- T{ face { edge 88 } { next-ring f } { base-face 22 } }
- T{ face { edge 92 } { next-ring f } { base-face 23 } }
- T{ face { edge 96 } { next-ring f } { base-face 24 } }
- T{ face { edge 100 } { next-ring f } { base-face 25 } }
- } }
- }
-
-CONSTANT: degenerate-incomplete-face
- T{ b-rep
- { edges {
- T{ b-edge { face 0 } { vertex 0 } { opposite-edge 5 } { next-edge 1 } }
- T{ b-edge { face 0 } { vertex 1 } { opposite-edge 4 } { next-edge 2 } }
- T{ b-edge { face 0 } { vertex 2 } { opposite-edge 3 } { next-edge 3 } }
- T{ b-edge { face 0 } { vertex 3 } { opposite-edge 2 } { next-edge 4 } }
- T{ b-edge { face 0 } { vertex 2 } { opposite-edge 1 } { next-edge 5 } }
- T{ b-edge { face 0 } { vertex 1 } { opposite-edge 0 } { next-edge 0 } }
- } }
- { vertices {
- T{ vertex { position double-4{ -1 -1 0 0 } } { edge 0 } }
- T{ vertex { position double-4{ 1 -1 0 0 } } { edge 1 } }
- T{ vertex { position double-4{ 1 1 0 0 } } { edge 2 } }
- T{ vertex { position double-4{ -1 1 0 0 } } { edge 3 } }
- } }
- { faces {
- T{ face { edge 0 } { next-ring f } { base-face 0 } }
- } }
- }
-
-CONSTANT: partially-degenerate-second-face
- T{ b-rep
- { edges {
- T{ b-edge { face 0 } { vertex 0 } { opposite-edge 6 } { next-edge 1 } }
- T{ b-edge { face 0 } { vertex 1 } { opposite-edge 5 } { next-edge 2 } }
- T{ b-edge { face 0 } { vertex 2 } { opposite-edge 4 } { next-edge 3 } }
- T{ b-edge { face 0 } { vertex 3 } { opposite-edge 9 } { next-edge 0 } }
-
- T{ b-edge { face 1 } { vertex 3 } { opposite-edge 2 } { next-edge 5 } }
- T{ b-edge { face 1 } { vertex 2 } { opposite-edge 1 } { next-edge 6 } }
- T{ b-edge { face 1 } { vertex 1 } { opposite-edge 0 } { next-edge 7 } }
- T{ b-edge { face 1 } { vertex 0 } { opposite-edge 8 } { next-edge 8 } }
- T{ b-edge { face 1 } { vertex 4 } { opposite-edge 7 } { next-edge 9 } }
- T{ b-edge { face 1 } { vertex 0 } { opposite-edge 3 } { next-edge 4 } }
- } }
- { vertices {
- T{ vertex { position double-4{ -1 -1 0 0 } } { edge 0 } }
- T{ vertex { position double-4{ 1 -1 0 0 } } { edge 1 } }
- T{ vertex { position double-4{ 1 1 0 0 } } { edge 2 } }
- T{ vertex { position double-4{ -1 1 0 0 } } { edge 3 } }
- T{ vertex { position double-4{ -2 -2 0 0 } } { edge 8 } }
- } }
- { faces {
- T{ face { edge 0 } { next-ring f } { base-face 0 } }
- T{ face { edge 4 } { next-ring f } { base-face 1 } }
- } }
- }
-
-: nth-when ( index/f seq -- elt/f )
- over [ nth ] [ 2drop f ] if ; inline
-
-:: connect-b-rep ( b-rep -- )
- b-rep faces>> [
- [ b-rep edges>> nth-when ] change-edge
- [ b-rep faces>> nth-when ] change-next-ring
- [ b-rep faces>> nth-when ] change-base-face
- drop
- ] each
-
- b-rep vertices>> [
- [ b-rep edges>> nth-when ] change-edge
- drop
- ] each
-
- b-rep edges>> [
- [ b-rep faces>> nth-when ] change-face
- [ b-rep vertices>> nth-when ] change-vertex
- [ b-rep edges>> nth-when ] change-opposite-edge
- [ b-rep edges>> nth-when ] change-next-edge
- drop
- ] each ;
-
-:: disconnect-b-rep ( b-rep -- )
- b-rep faces>> >index-hash :> face-indices
- b-rep edges>> >index-hash :> edge-indices
- b-rep vertices>> >index-hash :> vertex-indices
-
- b-rep faces>> [
- [ edge-indices at ] change-edge
- [ face-indices at ] change-next-ring
- [ face-indices at ] change-base-face
- drop
- ] each
-
- b-rep vertices>> [
- [ edge-indices at ] change-edge
- drop
- ] each
-
- b-rep edges>> [
- [ face-indices at ] change-face
- [ vertex-indices at ] change-vertex
- [ edge-indices at ] change-opposite-edge
- [ edge-indices at ] change-next-edge
- drop
- ] each ;
-
-valid-cube-b-rep connect-b-rep
-missing-face-cube-b-rep connect-b-rep
-non-quad-face-cube-b-rep connect-b-rep
-multi-ringed-face-cube-b-rep connect-b-rep
-valid-multi-valence-b-rep connect-b-rep
-degenerate-incomplete-face connect-b-rep
-partially-degenerate-second-face connect-b-rep
+++ /dev/null
-! (c) 2010 Joe Groff bsd license
-USING: euler.b-rep euler.b-rep.examples euler.b-rep.io.obj
-io.streams.string literals math.vectors.simd.cords tools.test ;
-IN: euler.b-rep.io.obj.tests
-
-CONSTANT: valid-cube-obj
-"""v -1.0 -1.0 -1.0
-v -1.0 1.0 -1.0
-v 1.0 -1.0 -1.0
-v 1.0 1.0 -1.0
-v -1.0 -1.0 1.0
-v -1.0 1.0 1.0
-v 1.0 -1.0 1.0
-v 1.0 1.0 1.0
-f 1 2 4 3
-f 5 6 2 1
-f 7 8 6 5
-f 3 4 8 7
-f 2 6 8 4
-f 5 1 3 7
-"""
-
-CONSTANT: valid-cube-obj-relative-indices
-"""v -1.0 -1.0 -1.0
-v -1.0 1.0 -1.0
-v 1.0 -1.0 -1.0
-v 1.0 1.0 -1.0
-f -4 -3 -1 -2
-v -1.0 -1.0 1.0
-v -1.0 1.0 1.0
-v 1.0 -1.0 1.0
-v 1.0 1.0 1.0
-f -4 -3 -7 -8
-f 7 8 6 5
-f 3 4 8 7
-f 2 6 8 4
-f 5 1 3 7
-"""
-
-CONSTANT: valid-cube-obj-texcoords
-"""# comment should be ignored
-v -1.0 -1.0 -1.0
-v -1.0 1.0 -1.0
-v 1.0 -1.0 -1.0
-v 1.0 1.0 -1.0
-v -1.0 -1.0 1.0
-v -1.0 1.0 1.0
-v 1.0 -1.0 1.0
-v 1.0 1.0 1.0
-vt 0 0
-vt 0 1
-vt 1 0
-vt 1 1
-f 1/1 2/2 4/4 3/3
-f 5/1 6/2 2/2 1/1
-f 7/3 8/4 6/2 5/1
-f 3/3 4/4 8/4 7/3
-f 2/2 6/2 8/4 4/4
-f 5/1 1/1 3/3 7/3
-"""
-
-{ $ valid-cube-obj } [ [ valid-cube-b-rep write-obj ] with-string-writer ] unit-test
-
-{
- V{
- double-4{ -1.0 -1.0 -1.0 0.0 }
- double-4{ -1.0 1.0 -1.0 0.0 }
- double-4{ 1.0 -1.0 -1.0 0.0 }
- double-4{ 1.0 1.0 -1.0 0.0 }
- double-4{ -1.0 -1.0 1.0 0.0 }
- double-4{ -1.0 1.0 1.0 0.0 }
- double-4{ 1.0 -1.0 1.0 0.0 }
- double-4{ 1.0 1.0 1.0 0.0 }
- }
- V{
- { 0 1 3 2 }
- { 4 5 1 0 }
- { 6 7 5 4 }
- { 2 3 7 6 }
- { 1 5 7 3 }
- { 4 0 2 6 }
- }
-} [
- valid-cube-obj [ (read-obj) ] with-string-reader
-] unit-test
-
-{
- V{
- double-4{ -1.0 -1.0 -1.0 0.0 }
- double-4{ -1.0 1.0 -1.0 0.0 }
- double-4{ 1.0 -1.0 -1.0 0.0 }
- double-4{ 1.0 1.0 -1.0 0.0 }
- double-4{ -1.0 -1.0 1.0 0.0 }
- double-4{ -1.0 1.0 1.0 0.0 }
- double-4{ 1.0 -1.0 1.0 0.0 }
- double-4{ 1.0 1.0 1.0 0.0 }
- }
- V{
- { 0 1 3 2 }
- { 4 5 1 0 }
- { 6 7 5 4 }
- { 2 3 7 6 }
- { 1 5 7 3 }
- { 4 0 2 6 }
- }
-} [
- valid-cube-obj-relative-indices [ (read-obj) ] with-string-reader
-] unit-test
-
-{
- V{
- double-4{ -1.0 -1.0 -1.0 0.0 }
- double-4{ -1.0 1.0 -1.0 0.0 }
- double-4{ 1.0 -1.0 -1.0 0.0 }
- double-4{ 1.0 1.0 -1.0 0.0 }
- double-4{ -1.0 -1.0 1.0 0.0 }
- double-4{ -1.0 1.0 1.0 0.0 }
- double-4{ 1.0 -1.0 1.0 0.0 }
- double-4{ 1.0 1.0 1.0 0.0 }
- }
- V{
- { 0 1 3 2 }
- { 4 5 1 0 }
- { 6 7 5 4 }
- { 2 3 7 6 }
- { 1 5 7 3 }
- { 4 0 2 6 }
- }
-} [
- valid-cube-obj-texcoords [ (read-obj) ] with-string-reader
-] unit-test
+++ /dev/null
-! (c) 2010 Joe Groff bsd license
-USING: accessors assocs combinators euler.b-rep fry
-game.models.half-edge grouping io kernel locals math
-math.parser math.vectors.simd.cords sequences splitting ;
-IN: euler.b-rep.io.obj
-
-<PRIVATE
-: write-obj-vertex ( vertex -- )
- "v " write
- position>> 3 head-slice [ bl ] [ number>string write ] interleave nl ;
-
-: write-obj-face ( face vx-indices -- )
- "f" write
- [ edge>> ] dip '[ bl vertex>> _ at 1 + number>string write ] each-face-edge nl ;
-PRIVATE>
-
-:: write-obj ( b-rep -- )
- b-rep vertices>> :> vertices
- vertices >index-hash :> vx-indices
-
- vertices [ write-obj-vertex ] each
- b-rep faces>> [ vx-indices write-obj-face ] each ;
-
-<PRIVATE
-:: reconstruct-face ( face-vertices vertices -- face edges )
- face new
- dup >>base-face
- :> face
- face-vertices [
- vertices nth :> vertex
- b-edge new
- vertex >>vertex
- face >>face
- :> edge
- vertex [ [ edge ] unless* ] change-edge drop
- edge
- ] { } map-as :> edges
-
- edges 1 edges length 1 + edges <circular-slice> [ >>next-edge drop ] 2each
- face edges first >>edge
- edges ;
-
-:: reconstruct-b-rep ( vertex-positions faces-vertices -- b-rep )
- vertex-positions [ vertex new swap >>position ] { } map-as :> vertices
- V{ } clone :> edges
- faces-vertices [ vertices reconstruct-face edges push-all ] { } map-as :> faces
-
- b-rep new
- faces >>faces
- edges >>edges
- vertices >>vertices
- dup connect-opposite-edges ;
-
-: parse-vertex ( line -- position )
- " " split first3 [ string>number >float ] tri@ 0.0 double-4-boa ;
-
-: read-vertex ( line vertices -- )
- [ parse-vertex ] dip push ;
-
-: parse-face-index ( token vertices -- index )
- swap "/" split1 drop string>number
- dup 0 >= [ nip 1 - ] [ [ length ] dip + ] if ;
-
-: parse-face ( line vertices -- vertices )
- [ " " split ] dip '[ _ parse-face-index ] map ;
-
-: read-face ( line vertices faces -- )
- [ parse-face ] dip push ;
-
-PRIVATE>
-
-:: (read-obj) ( -- vertices faces )
- V{ } clone :> vertices
- V{ } clone :> faces
- [
- " " split1 swap {
- { "#" [ drop ] }
- { "v" [ vertices read-vertex ] }
- { "f" [ vertices faces read-face ] }
- [ 2drop ]
- } case
- ] each-line
- vertices faces ;
-
-:: read-obj ( -- b-rep )
- (read-obj) reconstruct-b-rep ;
+++ /dev/null
-USING: accessors arrays assocs euler.b-rep
-game.models.half-edge kernel locals math math.vectors
-math.vectors.simd.cords sequences sets typed fry ;
-FROM: sequences.private => nth-unsafe set-nth-unsafe ;
-IN: euler.b-rep.subdivision
-
-: <vertex> ( position -- vertex ) vertex new swap >>position ; inline
-
-: face-points ( faces -- face-pts )
- [ edge>> face-midpoint <vertex> ] map ; inline
-
-:: edge-points ( edges edge-indices face-indices face-points -- edge-pts )
- edges length 0 <array> :> edge-pts
-
- edges [| edge n |
- edge opposite-edge>> :> opposite-edge
- opposite-edge edge-indices at :> opposite-n
-
- n opposite-n < [
- edge vertex>> position>>
- opposite-edge vertex>> position>> v+
- edge face>> face-indices at face-points nth position>> v+
- opposite-edge face>> face-indices at face-points nth position>> v+
- 0.25 v*n
- <vertex>
- [ n edge-pts set-nth-unsafe ]
- [ opposite-n edge-pts set-nth-unsafe ] bi
- ] when
- ] each-index
-
- edge-pts ; inline
-
-:: vertex-points ( vertices edge-indices face-indices edge-pts face-points -- vertex-pts )
- vertices [| vertex |
- 0 double-4{ 0 0 0 0 } double-4{ 0 0 0 0 }
- vertex edge>> [| valence face-sum edge-sum edge |
- valence 1 +
- face-sum edge face>> face-indices at face-points nth position>> v+
- edge-sum edge next-edge>> vertex>> position>> v+
- ] each-vertex-edge :> ( valence face-sum edge-sum )
- valence >float :> fvalence
- face-sum fvalence v/n :> face-avg
- edge-sum fvalence v/n :> edge-avg
- face-avg edge-avg v+ vertex position>> fvalence 2.0 - v*n v+
- fvalence v/n
- <vertex>
- ] map ; inline
-
-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 [ edg-b or ] change-edge drop
- point-c [ edg-c or ] change-edge drop
- point-d [ edg-d or ] change-edge drop
- ] 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 ;
+++ /dev/null
-USING: accessors arrays euler.b-rep.examples
-euler.b-rep.triangulation math.vectors.simd.cords sequences
-tools.test gml kernel ;
-IN: euler.b-rep.triangulation.tests
-
-: triangle-vx-positions ( triangles -- positions )
- [ [ position>> ] { } map-as ] { } map-as ;
-
-{
- {
- {
- double-4{ 1.0 1.0 -1.0 0.0 }
- double-4{ -1.0 -1.0 -1.0 0.0 }
- double-4{ -1.0 1.0 -1.0 0.0 }
- }
- {
- double-4{ -1.0 -1.0 -1.0 0.0 }
- double-4{ 1.0 1.0 -1.0 0.0 }
- double-4{ 1.0 -1.0 -1.0 0.0 }
- }
- }
-} [ valid-cube-b-rep faces>> first triangulate-face triangle-vx-positions ] unit-test
-
-{ { } } [ degenerate-incomplete-face faces>> first triangulate-face triangle-vx-positions ] unit-test
-{ {
- {
- double-4{ 1.0 1.0 0.0 0.0 }
- double-4{ -1.0 -1.0 0.0 0.0 }
- double-4{ -1.0 1.0 0.0 0.0 }
- }
- {
- double-4{ -1.0 -1.0 0.0 0.0 }
- double-4{ 1.0 1.0 0.0 0.0 }
- double-4{ 1.0 -1.0 0.0 0.0 }
- }
-} } [ partially-degenerate-second-face faces>> second triangulate-face triangle-vx-positions ] unit-test
-
-{
- {
- {
- double-4{ -1.0 1.0 0.0 0.0 }
- double-4{ -0.5 0.5 0.0 0.0 }
- double-4{ -1.0 -1.0 0.0 0.0 }
- }
- {
- double-4{ -0.5 0.5 0.0 0.0 }
- double-4{ -1.0 1.0 0.0 0.0 }
- double-4{ 1.0 1.0 0.0 0.0 }
- }
- {
- double-4{ -0.5 0.5 0.0 0.0 }
- double-4{ 1.0 1.0 0.0 0.0 }
- double-4{ 0.5 0.5 0.0 0.0 }
- }
- {
- double-4{ 0.5 0.5 0.0 0.0 }
- double-4{ 1.0 1.0 0.0 0.0 }
- double-4{ 0.5 -0.5 0.0 0.0 }
- }
- {
- double-4{ -1.0 -1.0 0.0 0.0 }
- double-4{ -0.5 -0.5 0.0 0.0 }
- double-4{ 1.0 -1.0 0.0 0.0 }
- }
- {
- double-4{ -0.5 -0.5 0.0 0.0 }
- double-4{ -1.0 -1.0 0.0 0.0 }
- double-4{ -0.5 0.5 0.0 0.0 }
- }
- {
- double-4{ 1.0 -1.0 0.0 0.0 }
- double-4{ -0.5 -0.5 0.0 0.0 }
- double-4{ 0.5 -0.5 0.0 0.0 }
- }
- {
- double-4{ 1.0 -1.0 0.0 0.0 }
- double-4{ 0.5 -0.5 0.0 0.0 }
- double-4{ 1.0 1.0 0.0 0.0 }
- }
- }
-} [
- [ "vocab:gml/examples/torus.gml" run-gml-file ] make-gml nip
- faces>> first triangulate-face triangle-vx-positions
-] unit-test
+++ /dev/null
-USING: accessors alien.c-types alien.handles euler.b-rep
-game.models.half-edge grouping kernel locals opengl.gl
-opengl.glu sequences specialized-arrays specialized-vectors
-libc destructors alien.data ;
-IN: euler.b-rep.triangulation
-
-SPECIALIZED-ARRAY: double
-
-ERROR: triangulated-face-must-be-base ;
-
-<PRIVATE
-
-: tess-begin ( -- callback )
- [| primitive-type vertices-h |
- primitive-type GL_TRIANGLES =
- [ "unexpected primitive type" throw ] unless
- ] GLUtessBeginDataCallback ;
-
-: tess-end ( -- callback )
- [| vertices-h |
- ! nop
- ] GLUtessEndDataCallback ;
-
-: tess-vertex ( -- callback )
- [| vertex-h vertices-h |
- vertex-h alien-handle-ptr>
- vertices-h alien-handle-ptr> push
- ] GLUtessVertexDataCallback ;
-
-: tess-edge-flag ( -- callback )
- [| flag vertices-h |
- ! nop
- ] GLUtessEdgeFlagDataCallback ;
-
-PRIVATE>
-
-:: triangulate-face ( face -- triangles )
- [
- face dup base-face>> eq? [ triangulated-face-must-be-base ] unless
-
- gluNewTess &gluDeleteTess :> tess
- V{ } clone :> vertices
- vertices <alien-handle-ptr> &release-alien-handle-ptr :> vertices-h
-
- tess GLU_TESS_BEGIN_DATA tess-begin gluTessCallback
- tess GLU_TESS_END_DATA tess-end gluTessCallback
- tess GLU_TESS_VERTEX_DATA tess-vertex gluTessCallback
- tess GLU_TESS_EDGE_FLAG_DATA tess-edge-flag gluTessCallback
-
- tess vertices-h gluTessBeginPolygon
-
- 4 double malloc-array &free :> vertex-buf
-
- face [| ring |
- tess gluTessBeginContour
-
- ring edge>> [
- tess swap vertex>>
- [ position>> double >c-array ]
- [ <alien-handle-ptr> &release-alien-handle-ptr ] bi gluTessVertex
- ] each-face-edge
-
- tess gluTessEndContour
-
- ring next-ring>> dup
- ] loop drop
- tess gluTessEndPolygon
-
- vertices { } like 3 <groups>
- ] with-destructors ;
+++ /dev/null
-USING: accessors kernel tools.test euler.b-rep euler.operators
-euler.modeling game.models.half-edge ;
-IN: euler.modeling.tests
-
-! polygon>double-face
-{ } [
- [
- { { -1 -1 0 } { 1 -1 0 } { 1 1 0 } { -1 1 0 } }
- smooth-smooth polygon>double-face
- [ face-sides 4 assert= ]
- [ opposite-edge>> face-sides 4 assert= ]
- [ face-normal { 0.0 0.0 1.0 } assert= ]
- tri
- ] make-b-rep check-b-rep
-] unit-test
-
-! extrude-simple
-{ } [
- [
- { { -1 -1 0 } { 1 -1 0 } { 1 1 0 } }
- smooth-smooth polygon>double-face
- 1 f extrude-simple
- [ face-sides 3 assert= ]
- [ opposite-edge>> face-sides 4 assert= ]
- bi
- ] make-b-rep check-b-rep
-] unit-test
-
-! project-pt-line
-{ { 0 1 0 } } [ { 0 0 0 } { 0 1 0 } { 1 1 0 } project-pt-line ] unit-test
-{ { 0 1 0 } } [ { 0 0 0 } { 1 1 0 } { 0 1 0 } project-pt-line ] unit-test
-{ { 0 1 0 } } [ { 0 0 0 } { 2 1 0 } { 1 1 0 } project-pt-line ] unit-test
-{ { -1 1 0 } } [ { -1 0 0 } { 2 1 0 } { 1 1 0 } project-pt-line ] unit-test
-{ { 1/2 1/2 0 } } [ { 0 0 0 } { 0 1 0 } { 1 0 0 } project-pt-line ] unit-test
-
-! project-pt-plane
-{ { 0 0 1 } } [ { 0 0 0 } { 0 0 1 } { 0 0 1 } -1 project-pt-plane ] unit-test
-{ { 0 0 -1 } } [ { 0 0 0 } { 0 0 1 } { 0 0 1 } 1 project-pt-plane ] unit-test
-{ { 0 0 3 } } [ { 0 0 0 } { 0 0 1 } { 0 0 1 } -3 project-pt-plane ] unit-test
-{ { 0 0 3 } } [ { 0 0 0 } { 0 0 1 } { 0 0 -1 } 3 project-pt-plane ] unit-test
-{ { 0 0 1 } } [ { 0 0 0 } { 0 0 1 } { 0 1 1 } -1 project-pt-plane ] unit-test
-
-{ { 0 2/3 1/3 } } [ { 0 0 0 } { 0 2 1 } { 0 1 1 } -1 project-pt-plane ] unit-test
-
-{ { 0 0 1 } } [ { 0 0 0 } { 0 0 1/2 } { 0 0 1 } -1 project-pt-plane ] unit-test
-{ { 0 1 1 } } [ { 0 0 0 } { 0 1/2 1/2 } { 0 0 1 } -1 project-pt-plane ] unit-test
+++ /dev/null
-! Copyright (C) 2010 Slava Pestov.
-USING: accessors combinators fry kernel locals math.vectors
-namespaces sets sequences game.models.half-edge euler.b-rep
-euler.operators math ;
-IN: euler.modeling
-
-: (polygon>double-face) ( polygon -- edge )
- [ first2 make-vefs ] keep
- [ drop opposite-edge>> ] [ 2 tail-slice [ make-ev-one ] each ] 2bi
- make-ef face-ccw ;
-
-SYMBOLS: smooth-smooth
-sharp-smooth
-smooth-sharp
-sharp-sharp
-smooth-like-vertex
-sharp-like-vertex
-smooth-continue
-sharp-continue ;
-
-: polygon>double-face ( polygon mode -- edge )
- ! This only handles the simple case with no repeating vertices
- drop
- dup all-unique? [ "polygon>double-face doesn't support repeating vertices yet" throw ] unless
- (polygon>double-face) ;
-
-:: extrude-simple ( edge dist sharp? -- edge )
- edge face-normal dist v*n :> vec
- edge vertex-pos vec v+ :> pos
- edge pos make-ev-one :> e0!
- e0 opposite-edge>> :> e-end
- edge face-ccw :> edge!
-
- [ edge e-end eq? not ] [
- edge vertex-pos vec v+ :> pos
- edge pos make-ev-one :> e1
- e0 e1 make-ef drop
- e1 e0!
- edge face-ccw edge!
- ] do while
-
- e-end face-ccw :> e-end
- e0 e-end make-ef drop
-
- e-end ;
-
-: check-bridge-rings ( e1 e2 -- )
- {
- [ [ face>> assert-no-rings ] bi@ ]
- [ [ face>> assert-base-face ] bi@ ]
- [ assert-different-faces ]
- [ [ face-sides ] bi@ assert= ]
- } 2cleave ;
-
-:: bridge-rings-simple ( e1 e2 sharp? -- edge )
- e1 e2 check-bridge-rings
- e1 e2 kill-f-make-rh
- e1 e2 make-e-kill-r face-cw :> ea!
- e2 face-ccw :> eb!
- [ ea e1 eq? not ] [
- ea eb make-ef opposite-edge>> face-cw ea!
- eb face-ccw eb!
- ] while
- eb ;
-
-:: project-pt-line ( p p0 p1 -- q )
- p1 p0 v- :> vt
- p p0 v- vt v* sum
- vt norm-sq /
- vt n*v p0 v+ ; inline
-
-:: project-pt-plane ( line-p0 line-vt plane-n plane-d -- q )
- plane-d neg plane-n line-p0 v. -
- line-vt plane-n v. /
- line-vt n*v line-p0 v+ ; inline
-
-: project-poly-plane ( poly vdir plane-n plane-d -- qoly )
- '[ _ _ _ project-pt-plane ] map ; inline
+++ /dev/null
-USING: accessors euler.operators euler.modeling euler.b-rep
-kernel tools.test game.models.half-edge combinators namespaces
-fry sequences make ;
-FROM: euler.b-rep => has-rings? ;
-IN: euler.operators.tests
-
-{ t } [ [ ] make-b-rep b-rep? ] unit-test
-
-{ } [
- [
- { 1 0 0 }
- { 0 1 0 }
- make-vefs
- {
- [ face-ccw vertex-pos { 1 0 0 } assert= ]
- [ vertex-pos { 0 1 0 } assert= ]
- [ vertex-valence 1 assert= ]
- [ face-ccw vertex-valence 1 assert= ]
- [ dup face-ccw assert-same-face ]
- } cleave
- ] make-b-rep check-b-rep
-] unit-test
-
-{ } [
- [
- { 1 0 0 }
- { 0 1 0 }
- make-vefs
- kill-vefs
- ] make-b-rep assert-empty-b-rep
-] unit-test
-
-[
- [
- { 1 0 0 }
- { 0 1 0 }
- make-vefs
- dup face-ccw
- { 0 0 1 } make-ev
- ] make-b-rep
-] [ edges-not-incident? ] must-fail-with
-
-{ } [
- [
- 0
- 1
- make-vefs
- dup 2 make-ev
- [ vertex-pos 2 assert= ]
- [ opposite-edge>> vertex-pos 1 assert= ]
- bi
- ] make-b-rep check-b-rep
-] unit-test
-
-{ } [
- [
- { 1 0 0 }
- { 0 1 0 }
- make-vefs
- dup dup { 0 0 1 } make-ev kill-ev
- kill-vefs
- ] make-b-rep assert-empty-b-rep
-] unit-test
-
-{ } [
- [
- { 1 2 3 } smooth-smooth polygon>double-face
- dup face-cw opposite-edge>>
- 2dup [ "a" set ] [ "b" set ] bi*
- 4 make-ev {
- [ face-sides 4 assert= ]
- [ vertex-pos 4 assert= ]
- [ opposite-edge>> face-sides 4 assert= ]
- [ face-ccw "b" get assert= ]
- [ face-cw "a" get opposite-edge>> assert= ]
- } cleave
- ] make-b-rep check-b-rep
-] unit-test
-
-{ } [
- [
- { 1 2 3 4 } smooth-smooth polygon>double-face
- [ face-ccw opposite-edge>> ]
- [ face-ccw face-ccw ]
- [ dup face-ccw face-ccw make-ef drop ] tri
- 5 make-ev {
- [ vertex-pos 5 assert= ]
- [ face-sides 4 assert= ]
- } cleave
- ] make-b-rep check-b-rep
-] unit-test
-
-{ } [
- [
- { 1 0 0 }
- { 0 1 0 }
- make-vefs
- [
- dup dup make-ef
- [ face>> ] bi@ eq? f assert=
- ]
- [ vertex-valence 3 assert= ]
- bi
- ] make-b-rep check-b-rep
-] unit-test
-
-[
- [
- { 1 0 0 }
- { 0 1 0 }
- make-vefs
- dup dup make-ef make-ef
- ] make-b-rep
-] [ edges-in-different-faces? ] must-fail-with
-
-{ } [
- [
- { 1 0 0 }
- { 0 1 0 }
- make-vefs
- dup opposite-edge>>
- [ [ "a" set ] [ "b" set ] bi* ]
- [
- make-ef
- {
- [ vertex-valence 2 assert= ]
- [ opposite-edge>> vertex-valence 2 assert= ]
- [ next-edge>> "a" get assert= ]
- [ opposite-edge>> next-edge>> "b" get assert= ]
- [ dup opposite-edge>> [ face>> ] bi@ eq? f assert= ]
- } cleave
- ] 2bi
- ] make-b-rep check-b-rep
-] unit-test
-
-{ } [
- [
- { 1 2 3 4 } smooth-smooth polygon>double-face
- { 5 6 7 8 } smooth-smooth polygon>double-face
- { 9 10 11 12 } smooth-smooth polygon>double-face
- {
- [ [ drop ] dip kill-f-make-rh ]
- [ [ drop ] 2dip kill-f-make-rh ]
- [ [ drop ] dip [ face>> ] bi@ [ base-face>> ] dip assert= ]
- [ [ drop ] 2dip [ face>> ] bi@ [ base-face>> ] dip assert= ]
- [ 2nip face>> has-rings? t assert= ]
- [ drop drop make-f-kill-rh ]
- [ drop nip make-f-kill-rh ]
- [ drop drop face>> dup base-face>> assert= ]
- [ drop nip face>> dup base-face>> assert= ]
- [ 2nip face>> has-rings? f assert= ]
- } 3cleave
- ] make-b-rep check-b-rep
-] unit-test
-
-{
- { 0 1 0 }
- { 1 0 0 }
- { 1 2 1 }
- { 2 1 1 }
-} [
- [
- { 1 0 0 }
- { 0 1 0 }
- make-vefs
- dup opposite-edge>>
- {
- [ [ vertex-pos ] bi@ ]
- [ drop { 1 1 1 } move-e ]
- [ [ vertex-pos ] bi@ ]
- } 2cleave
- ] make-b-rep check-b-rep
-] unit-test
-
-{
- {
- { 2 1 1 }
- { 1 2 1 }
- { 1 1 2 }
- }
-} [
- [
- { { 1 0 0 } { 0 1 0 } { 0 0 1 } } smooth-smooth polygon>double-face
- [ { 1 1 1 } move-f ]
- [ [ [ vertex-pos , ] each-face-edge ] { } make ]
- bi
- ] make-b-rep check-b-rep
-] unit-test
-
-! Make sure we update the face's edge when killing an edge
-{ } [
- [
- { 1 2 3 4 } smooth-smooth polygon>double-face
- kill-ev
- ] make-b-rep check-b-rep
-] unit-test
-
-{ } [
- [
- { 1 2 3 4 } smooth-smooth polygon>double-face
- face-ccw kill-ev
- ] make-b-rep check-b-rep
-] unit-test
-
-{ } [
- [
- { 1 2 3 4 } smooth-smooth polygon>double-face
- face-ccw face-ccw kill-ev
- ] make-b-rep check-b-rep
-] unit-test
-
-{ } [
- [
- { 1 2 3 4 } smooth-smooth polygon>double-face
- face-ccw face-ccw face-ccw kill-ev
- ] make-b-rep check-b-rep
-] unit-test
+++ /dev/null
-! Copyright (C) 2010 Slava Pestov.
-USING: accessors combinators fry kernel locals namespaces
-game.models.half-edge euler.b-rep sequences typed math
-math.vectors ;
-IN: euler.operators
-
-ERROR: edges-not-incident ;
-
-: assert-incident ( e1 e2 -- )
- incident? [ edges-not-incident ] unless ;
-
-ERROR: should-not-be-equal obj1 obj2 ;
-
-: assert-not= ( obj1 obj2 -- )
- 2dup eq? [ should-not-be-equal ] [ 2drop ] if ;
-
-ERROR: edges-in-different-faces ;
-
-: assert-same-face ( e1 e2 -- )
- same-face? [ edges-in-different-faces ] unless ;
-
-ERROR: edges-in-same-face ;
-
-: assert-different-faces ( e1 e2 -- )
- same-face? [ edges-in-same-face ] when ;
-
-: assert-isolated-component ( edge -- )
- [ [ opposite-edge>> ] [ next-edge>> ] bi assert= ]
- [ dup opposite-edge>> assert-same-face ]
- bi ;
-
-ERROR: not-a-base-face face ;
-
-: assert-base-face ( face -- )
- dup base-face? [ drop ] [ not-a-base-face ] if ;
-
-ERROR: has-rings face ;
-
-: assert-no-rings ( face -- )
- dup next-ring>> [ has-rings ] [ drop ] if ;
-
-: assert-ring-of ( ring face -- )
- [ base-face>> ] dip assert= ;
-
-: with-b-rep ( b-rep quot -- )
- [ b-rep ] dip with-variable ; inline
-
-: make-b-rep ( quot -- b-rep )
- <b-rep> [ swap with-b-rep ] [ finish-b-rep ] [ ] tri ; inline
-
-<PRIVATE
-
-:: make-loop ( vertex face -- edge )
- b-rep get new-edge :> edge
- vertex edge vertex<<
- edge edge next-edge<<
- face edge face<<
-
- edge ;
-
-: make-loop-face ( vertex -- edge )
- b-rep get new-face
- dup >>base-face
- make-loop ;
-
-:: make-edge ( vertex next-edge -- edge )
- b-rep get new-edge :> edge
- vertex edge vertex<<
- next-edge edge next-edge<<
- next-edge face>> edge face<<
-
- edge ;
-
-: opposite-edges ( e1 e2 -- )
- [ opposite-edge<< ] [ swap opposite-edge<< ] 2bi ;
-
-PRIVATE>
-
-MIXIN: point
-INSTANCE: sequence point
-INSTANCE: number point
-
-TYPED:: make-vefs ( pos1: point pos2: point -- edge: b-edge )
- b-rep get :> b-rep
-
- pos1 b-rep new-vertex :> v1
- v1 make-loop-face :> e1
-
- pos2 b-rep new-vertex :> v2
- v2 e1 make-edge :> e2
-
- e2 e1 next-edge<<
- e1 e2 opposite-edges
-
- e2 ;
-
-TYPED:: make-ev-one ( edge: b-edge point: point -- edge: b-edge )
- point b-rep get new-vertex :> v
- v edge make-edge :> e1'
-
- edge vertex>> e1' make-edge :> e2'
-
- e2' edge face-cw next-edge<<
- e1' e2' opposite-edges
-
- e1' ;
-
-<PRIVATE
-
-:: subdivide-vertex-cycle ( e1 e2 v -- )
- e1 e2 eq? [
- v e1 vertex<<
- e1 vertex-cw e2 v subdivide-vertex-cycle
- ] unless ;
-
-:: (make-ev) ( e1 e2 point -- edge )
- e1 e2 assert-incident
-
- point b-rep get new-vertex :> v'
- v' e2 make-edge :> e1'
-
- e1 vertex>> :> v
-
- v e1 make-edge :> e2'
-
- e1 e2 v' subdivide-vertex-cycle
-
- e1 face-cw :> e1p
- e2 face-cw :> e2p
- e1 opposite-edge>> :> e1m
-
- e1m e1p assert-not=
-
- e1' e2p next-edge<<
- e2' e1p next-edge<<
-
- e1' e2' opposite-edges
-
- e1' ;
-
-PRIVATE>
-
-TYPED:: make-ev ( e1: b-edge e2: b-edge point: point -- edge: b-edge )
- e1 e2 eq?
- [ e1 point make-ev-one ] [ e1 e2 point (make-ev) ] if ;
-
-<PRIVATE
-
-: subdivide-edge-cycle ( face e1 e2 -- )
- 2dup eq? [ 3drop ] [
- [ drop face<< ]
- [ [ next-edge>> ] dip subdivide-edge-cycle ] 3bi
- ] if ;
-
-PRIVATE>
-
-TYPED:: make-ef ( e1: b-edge e2: b-edge -- edge: b-edge )
- e1 e2 assert-same-face
-
- e2 vertex>> make-loop-face :> e1'
- e1 vertex>> e2 make-edge :> e2'
- e1' e2' opposite-edges
-
- e1 face-cw :> e1p
-
- e1 e2 eq? [
- e2 face-cw :> e2p
-
- e1' face>> e1 e2 subdivide-edge-cycle
-
- e1' e2p next-edge<<
- e1 e1' next-edge<<
- ] unless
-
- e2' e1p next-edge<<
- e1' ;
-
-TYPED:: make-e-kill-r ( edge-ring: b-edge edge-face: b-edge -- edge: b-edge )
- edge-ring face>> :> ring
- edge-face face>> :> face
- ring face assert-ring-of
-
- edge-ring [ face >>face drop ] each-face-edge
-
- edge-ring vertex>> edge-face make-edge :> e1
- edge-face vertex>> edge-ring make-edge :> e2
-
- ring face delete-ring
- ring b-rep get delete-face
-
- e2 edge-face face-cw next-edge<<
- e1 edge-ring face-cw next-edge<<
-
- e1 e2 opposite-edges
-
- e1 ;
-
-TYPED:: make-f-kill-rh ( edge-ring: b-edge -- )
- edge-ring face>> :> ring
- ring base-face>> :> base-face
- ring base-face delete-ring
- ring ring base-face<< ;
-
-TYPED:: kill-vefs ( edge: b-edge -- )
- edge assert-isolated-component
-
- b-rep get :> b-rep
- edge dup opposite-edge>> :> ( e2 e1 )
-
- e1 vertex>> :> v1
- e2 vertex>> :> v2
-
- e1 face>> b-rep delete-face
-
- e1 b-rep delete-edge
- e2 b-rep delete-edge
- v1 b-rep delete-vertex
- v2 b-rep delete-vertex ;
-
-TYPED:: kill-ev ( edge: b-edge -- )
- b-rep get :> b-rep
-
- edge vertex>> :> v
- edge opposite-edge>> :> edge'
- edge' vertex>> :> v'
-
- edge [ v' >>vertex drop ] each-vertex-edge
-
- edge face-cw :> edgep
- edge' face-cw :> edge'p
-
- edge next-edge>> edgep next-edge<<
- edge' next-edge>> edge'p next-edge<<
-
- v b-rep delete-vertex
- edge b-rep delete-edge
- edge' b-rep delete-edge ;
-
-TYPED:: kill-ef ( edge: b-edge -- )
- b-rep get :> b-rep
-
- edge :> e1
- edge opposite-edge>> :> e2
-
- e1 e2 assert-different-faces
-
- e1 face-cw :> e1p
- e2 face-cw :> e2p
-
- e1 face>> :> f1
- e2 face>> :> f2
-
- e1 [ f2 >>face drop ] each-face-edge
- f1 b-rep delete-face
-
- e1 e2 incident? [
- e2 next-edge>> e2p next-edge<<
-
- ] [
- e2 next-edge>> e1p next-edge<<
- e1 next-edge>> e2p next-edge<<
- ] if
-
- e1 b-rep delete-edge
- e2 b-rep delete-edge ;
-
-TYPED:: kill-e-make-r ( edge: b-edge -- edge-ring: b-edge )
- b-rep get :> b-rep
-
- edge opposite-edge>> :> edge'
- edge' next-edge>> :> edge-ring
- edge-ring opposite-edge>> :> edge-ring'
-
- edge edge' assert-same-face
- edge edge-ring assert-same-face
- edge edge-ring' assert-different-faces
-
- b-rep new-face :> ring
-
- ring edge face>> base-face>> add-ring
- ring edge' edge subdivide-edge-cycle
-
- edge b-rep delete-edge
- edge' b-rep delete-edge
-
- edge-ring ;
-
-TYPED:: kill-f-make-rh ( edge-face: b-edge edge-base-face: b-edge -- )
- edge-face face>> :> face
- edge-base-face face>> :> base-face
-
- face assert-base-face
- base-face assert-base-face
- edge-face edge-base-face assert-different-faces
-
- face base-face add-ring ;
-
-TYPED: move-v ( edge: b-edge point: point -- )
- swap vertex>> position<< ;
-
-TYPED: move-e ( edge: b-edge offset: point -- )
- [ dup opposite-edge>> ] dip
- '[ vertex>> [ _ v+ ] change-position drop ] bi@ ;
-
-TYPED: move-f ( edge: b-edge offset: point -- )
- '[ vertex>> [ _ v+ ] change-position drop ] each-face-edge ;
-
-TYPED: sharp-e ( edge: b-edge sharp?: boolean -- )
- >>sharpness drop ;
-
-TYPED: sharp-f ( edge: b-edge sharp?: boolean -- )
- '[ _ sharp-e ] each-face-edge ;
-
-TYPED: sharp-v ( edge: b-edge sharp?: boolean -- )
- '[ _ sharp-e ] each-vertex-edge ;
-
-TYPED: material-f ( edge: b-edge material -- ) 2drop ;
--- /dev/null
+USING: accessors euler.b-rep euler.modeling euler.operators
+euler.b-rep.examples kernel locals math.vectors.simd.cords
+namespaces sequences tools.test ;
+IN: euler.b-rep.tests
+
+{ double-4{ 0.0 0.0 -1.0 0.0 } }
+[ valid-cube-b-rep edges>> first face-normal ] unit-test
+
+{ double-4{ 0.0 0.0 -1.0 0.0 } -1.0 }
+[ valid-cube-b-rep edges>> first face-plane ] unit-test
+
+{ t } [ 0 multi-ringed-face-cube-b-rep faces>> nth base-face? ] unit-test
+{ t } [ 5 multi-ringed-face-cube-b-rep faces>> nth base-face? ] unit-test
+{ f } [ 6 multi-ringed-face-cube-b-rep faces>> nth base-face? ] unit-test
+
+:: mock-face ( p0 p1 p2 -- edge )
+ b-edge new vertex new p0 >>position >>vertex :> e0
+ b-edge new vertex new p1 >>position >>vertex :> e1
+ b-edge new vertex new p2 >>position >>vertex :> e2
+
+ e1 e0 next-edge<<
+ e2 e1 next-edge<<
+ e0 e2 next-edge<<
+
+ e0 ;
+
+{
+ double-4{
+ 0x1.279a74590331dp-1
+ 0x1.279a74590331dp-1
+ 0x1.279a74590331dp-1
+ 0.0
+ }
+ -0x1.bb67ae8584cabp1
+} [
+ double-4{ 1 0 5 0 }
+ double-4{ 0 1 5 0 }
+ double-4{ 0 0 6 0 } mock-face face-plane
+] unit-test
+
+V{ t } clone sharpness-stack [
+ [ t ] [ get-sharpness ] unit-test
+ [ V{ f } ] [ f set-sharpness sharpness-stack get ] unit-test
+ [ V{ f t } t ] [ t push-sharpness sharpness-stack get get-sharpness ] unit-test
+ [ t V{ f } f ] [ pop-sharpness sharpness-stack get get-sharpness ] unit-test
+] with-variable
+
+{ t } [ valid-cube-b-rep [ edges>> first ] keep is-valid-edge? ] unit-test
+{ f } [ b-edge new valid-cube-b-rep is-valid-edge? ] unit-test
+
+{ t } [
+ valid-cube-b-rep edges>>
+ [ [ 0 swap nth ] [ 1 swap nth ] bi connecting-edge ]
+ [ 0 swap nth ] bi eq?
+] unit-test
+
+{ t } [
+ valid-cube-b-rep edges>>
+ [ [ 1 swap nth ] [ 0 swap nth ] bi connecting-edge ]
+ [ 6 swap nth ] bi eq?
+] unit-test
+
+{ t } [
+ valid-cube-b-rep edges>>
+ [ [ 0 swap nth ] [ 3 swap nth ] bi connecting-edge ]
+ [ 21 swap nth ] bi eq?
+] unit-test
+
+{ f } [
+ valid-cube-b-rep edges>>
+ [ 0 swap nth ] [ 2 swap nth ] bi connecting-edge
+] unit-test
+
+{ double-4{ 0 0 -1 0 } } [
+ [
+ { double-4{ 0 0 0 0 } double-4{ 0 1 0 0 } double-4{ 0 2 0 0 } double-4{ 1 1 0 0 } }
+ smooth-smooth polygon>double-face face-normal
+ ] make-b-rep drop
+] unit-test
--- /dev/null
+! Copyright (C) 2010 Slava Pestov.
+USING: accessors fry kernel locals sequences sets namespaces
+combinators combinators.short-circuit game.models.half-edge
+math math.vectors math.matrices assocs arrays hashtables ;
+FROM: namespaces => set ;
+IN: euler.b-rep
+
+: >index-hash ( seq -- hash ) H{ } zip-index-as ; inline
+
+TUPLE: b-edge < edge sharpness macro ;
+
+TUPLE: vertex < identity-tuple position edge ;
+
+TUPLE: face < identity-tuple edge next-ring base-face ;
+
+:: (opposite) ( e1 e2 quot: ( edge -- edge' ) -- edge )
+ e1 quot call :> e0
+ e0 e2 eq? [ e1 ] [ e0 e2 quot (opposite) ] if ;
+ inline recursive
+
+: opposite ( edge quot: ( edge -- edge' ) -- edge )
+ dupd (opposite) ; inline
+
+: face-ccw ( edge -- edge ) next-edge>> ; inline
+
+: face-cw ( edge -- edge ) [ face-ccw ] opposite ; inline
+
+: vertex-cw ( edge -- edge ) opposite-edge>> next-edge>> ; inline
+
+: vertex-ccw ( edge -- edge ) [ vertex-cw ] opposite ; inline
+
+: base-face? ( face -- ? ) dup base-face>> eq? ; inline
+
+: has-rings? ( face -- ? ) next-ring>> >boolean ; inline
+
+: incident? ( e1 e2 -- ? ) [ vertex>> ] bi@ eq? ; inline
+
+TUPLE: b-rep < identity-tuple faces edges vertices ;
+
+: <b-rep> ( -- b-rep )
+ V{ } clone V{ } clone V{ } clone b-rep boa ;
+
+SYMBOL: sharpness-stack
+sharpness-stack [ V{ t } ] initialize
+
+: set-sharpness ( sharp? -- ) >boolean sharpness-stack get set-last ;
+: get-sharpness ( -- sharp? ) sharpness-stack get last ;
+
+: push-sharpness ( sharp? -- ) >boolean sharpness-stack get push ;
+: pop-sharpness ( -- sharp? )
+ sharpness-stack get
+ dup length 1 = [ first ] [ pop ] if ;
+
+: new-vertex ( position b-rep -- vertex )
+ [ f vertex boa dup ] dip vertices>> push ; inline
+
+: new-edge ( b-rep -- edge )
+ [ b-edge new get-sharpness >>sharpness dup ] dip edges>> push ; inline
+
+: new-face ( b-rep -- face )
+ [ face new dup ] dip faces>> push ; inline
+
+: delete-vertex ( vertex b-rep -- )
+ vertices>> remove! drop ; inline
+
+: delete-edge ( edge b-rep -- )
+ edges>> remove! drop ; inline
+
+: delete-face ( face b-rep -- )
+ faces>> remove! drop ; inline
+
+: add-ring ( ring base-face -- )
+ [ >>base-face drop ]
+ [ next-ring>> >>next-ring drop ]
+ [ swap >>next-ring drop ]
+ 2tri ;
+
+: delete-ring ( ring base-face -- )
+ 2dup next-ring>> eq?
+ [ [ next-ring>> ] dip next-ring<< ]
+ [ next-ring>> delete-ring ]
+ if ;
+
+: vertex-pos ( edge -- pos )
+ vertex>> position>> ; inline
+
+: same-edge? ( e1 e2 -- ? )
+ { [ eq? ] [ opposite-edge>> eq? ] } 2|| ;
+
+: same-face? ( e1 e2 -- ? )
+ [ face>> ] bi@ eq? ;
+
+: edge-direction ( edge -- v )
+ [ face-ccw ] keep [ vertex-pos ] bi@ v- ;
+
+: normal ( v0 v1 v2 -- v )
+ [ drop v- ] [ [ drop ] 2dip v- ] 3bi cross ;
+
+ERROR: all-points-colinear ;
+
+: face-normal ( edge -- n )
+ face-edges
+ [
+ dup face-ccw dup face-ccw
+ [ vertex-pos ] tri@ normal
+ ] map
+ [ [ zero? ] all? not ] find nip
+ [ normalize ] [ all-points-colinear ] if* ;
+
+: (face-plane-dist) ( normal edge -- d )
+ vertex-pos v. neg ; inline
+
+: face-plane-dist ( edge -- d )
+ [ face-normal ] [ (face-plane-dist) ] bi ; inline
+
+: face-plane ( edge -- n d )
+ [ face-normal dup ] [ (face-plane-dist) ] bi ; inline
+
+: face-midpoint ( edge -- v )
+ face-edges
+ [ [ vertex-pos ] [ v+ ] map-reduce ] [ length ] bi v/n ;
+
+: clear-b-rep ( b-rep -- )
+ [ faces>> delete-all ]
+ [ edges>> delete-all ]
+ [ vertices>> delete-all ]
+ tri ;
+
+: connect-opposite-edges ( b-rep -- )
+ edges>>
+ [ [ [ next-edge>> vertex>> ] [ vertex>> 2array ] [ ] tri ] H{ } map>assoc ]
+ [ swap '[ [ vertex>> ] [ next-edge>> vertex>> 2array _ at ] [ opposite-edge<< ] tri ] each ] bi ;
+
+: connect-faces ( b-rep -- )
+ edges>> [ dup face>> edge<< ] each ;
+
+: connect-vertices ( b-rep -- )
+ edges>> [ dup vertex>> edge<< ] each ;
+
+: finish-b-rep ( b-rep -- )
+ [ connect-faces ] [ connect-vertices ] bi ;
+
+: characteristic ( b-rep -- n )
+ ! Assumes b-rep is connected and all faces are convex
+ [ vertices>> length ]
+ [ edges>> length 2 / ]
+ [ faces>> [ base-face? ] count ] tri
+ [ - ] dip + ;
+
+: genus ( b-rep -- n )
+ ! Assumes b-rep is connected and all faces are convex
+ characteristic 2 swap - 2 / ;
+
+SYMBOLS: live-vertices live-edges live-faces ;
+
+ERROR: dead-vertex vertex ;
+
+: check-live-vertex ( vertex -- )
+ dup live-vertices get in? [ drop ] [ dead-vertex ] if ;
+
+ERROR: dead-edge edge ;
+
+: check-live-edge ( edge -- )
+ dup live-edges get in? [ drop ] [ dead-edge ] if ;
+
+ERROR: dead-face face ;
+
+: check-live-face ( face -- )
+ dup live-faces get in? [ drop ] [ dead-face ] if ;
+
+: check-vertex ( vertex -- )
+ [ edge>> check-live-edge ]
+ [ dup edge>> [ vertex>> assert= ] with each-vertex-edge ]
+ bi ;
+
+: check-edge ( edge -- )
+ {
+ [ vertex>> check-live-vertex ]
+ [ opposite-edge>> check-live-edge ]
+ [ face>> check-live-face ]
+ [ dup opposite-edge>> opposite-edge>> assert= ]
+ } cleave ;
+
+: check-face ( face -- )
+ [ edge>> check-live-edge ]
+ [ dup edge>> [ face>> assert= ] with each-face-edge ]
+ bi ;
+
+: check-ring ( base-face face -- )
+ [ check-face ] [ base-face>> assert= ] bi ;
+
+: check-base-face ( face -- )
+ [ check-face ]
+ [ dup [ next-ring>> ] follow rest [ check-ring ] with each ] bi ;
+
+: check-b-rep ( b-rep -- )
+ [
+ [
+ [ vertices>> fast-set live-vertices set ]
+ [ edges>> fast-set live-edges set ]
+ [ faces>> fast-set live-faces set ] tri
+ ]
+ [
+ [ vertices>> [ check-vertex ] each ]
+ [ edges>> [ check-edge ] each ]
+ [ faces>> [ base-face? ] filter [ check-base-face ] each ] tri
+ ] bi
+ ] with-scope ;
+
+: empty-b-rep? ( b-rep -- ? )
+ [ faces>> ] [ edges>> ] [ vertices>> ] tri
+ [ empty? ] tri@ and and ;
+
+ERROR: b-rep-not-empty b-rep ;
+
+: assert-empty-b-rep ( b-rep -- )
+ dup empty-b-rep? [ drop ] [ b-rep-not-empty ] if ;
+
+: is-valid-edge? ( e brep -- ? )
+ edges>> member? ; inline
+
+: edge-endpoints ( edge -- from to )
+ [ vertex>> position>> ]
+ [ opposite-edge>> vertex>> position>> ] bi ; inline
+
+:: connecting-edge ( e0 e1 -- edge/f )
+ e1 vertex>> :> target-vertex
+ e0 vertex>> target-vertex eq? [ f ] [
+ f e0 [| ret edge |
+ edge opposite-edge>> vertex>> target-vertex eq?
+ [ edge edge f ]
+ [ f edge vertex-cw dup e0 eq? not ] if
+ ] loop drop
+ ] if ;
--- /dev/null
+USING: accessors assocs euler.b-rep game.models.half-edge
+kernel locals math.vectors.simd.cords sequences ;
+IN: euler.b-rep.examples
+
+CONSTANT: valid-cube-b-rep
+ T{ b-rep
+ { faces {
+ T{ face { edge 0 } { next-ring f } { base-face 0 } }
+ T{ face { edge 4 } { next-ring f } { base-face 1 } }
+ T{ face { edge 8 } { next-ring f } { base-face 2 } }
+ T{ face { edge 12 } { next-ring f } { base-face 3 } }
+ T{ face { edge 16 } { next-ring f } { base-face 4 } }
+ T{ face { edge 20 } { next-ring f } { base-face 5 } }
+ } }
+ { edges {
+ T{ b-edge { face 0 } { vertex 0 } { opposite-edge 6 } { next-edge 1 } }
+ T{ b-edge { face 0 } { vertex 1 } { opposite-edge 19 } { next-edge 2 } }
+ T{ b-edge { face 0 } { vertex 3 } { opposite-edge 12 } { next-edge 3 } }
+ T{ b-edge { face 0 } { vertex 2 } { opposite-edge 21 } { next-edge 0 } }
+
+ T{ b-edge { face 1 } { vertex 4 } { opposite-edge 10 } { next-edge 5 } }
+ T{ b-edge { face 1 } { vertex 5 } { opposite-edge 16 } { next-edge 6 } }
+ T{ b-edge { face 1 } { vertex 1 } { opposite-edge 0 } { next-edge 7 } }
+ T{ b-edge { face 1 } { vertex 0 } { opposite-edge 20 } { next-edge 4 } }
+
+ T{ b-edge { face 2 } { vertex 6 } { opposite-edge 14 } { next-edge 9 } }
+ T{ b-edge { face 2 } { vertex 7 } { opposite-edge 17 } { next-edge 10 } }
+ T{ b-edge { face 2 } { vertex 5 } { opposite-edge 4 } { next-edge 11 } }
+ T{ b-edge { face 2 } { vertex 4 } { opposite-edge 23 } { next-edge 8 } }
+
+ T{ b-edge { face 3 } { vertex 2 } { opposite-edge 2 } { next-edge 13 } }
+ T{ b-edge { face 3 } { vertex 3 } { opposite-edge 18 } { next-edge 14 } }
+ T{ b-edge { face 3 } { vertex 7 } { opposite-edge 8 } { next-edge 15 } }
+ T{ b-edge { face 3 } { vertex 6 } { opposite-edge 22 } { next-edge 12 } }
+
+ T{ b-edge { face 4 } { vertex 1 } { opposite-edge 5 } { next-edge 17 } }
+ T{ b-edge { face 4 } { vertex 5 } { opposite-edge 9 } { next-edge 18 } }
+ T{ b-edge { face 4 } { vertex 7 } { opposite-edge 13 } { next-edge 19 } }
+ T{ b-edge { face 4 } { vertex 3 } { opposite-edge 1 } { next-edge 16 } }
+
+ T{ b-edge { face 5 } { vertex 4 } { opposite-edge 7 } { next-edge 21 } }
+ T{ b-edge { face 5 } { vertex 0 } { opposite-edge 3 } { next-edge 22 } }
+ T{ b-edge { face 5 } { vertex 2 } { opposite-edge 15 } { next-edge 23 } }
+ T{ b-edge { face 5 } { vertex 6 } { opposite-edge 11 } { next-edge 20 } }
+ } }
+ { vertices {
+ T{ vertex { position double-4{ -1.0 -1.0 -1.0 0.0 } } { edge 0 } }
+ T{ vertex { position double-4{ -1.0 1.0 -1.0 0.0 } } { edge 1 } }
+ T{ vertex { position double-4{ 1.0 -1.0 -1.0 0.0 } } { edge 3 } }
+ T{ vertex { position double-4{ 1.0 1.0 -1.0 0.0 } } { edge 2 } }
+ T{ vertex { position double-4{ -1.0 -1.0 1.0 0.0 } } { edge 4 } }
+ T{ vertex { position double-4{ -1.0 1.0 1.0 0.0 } } { edge 5 } }
+ T{ vertex { position double-4{ 1.0 -1.0 1.0 0.0 } } { edge 8 } }
+ T{ vertex { position double-4{ 1.0 1.0 1.0 0.0 } } { edge 9 } }
+ } }
+ }
+
+CONSTANT: missing-face-cube-b-rep
+ T{ b-rep
+ { faces {
+ T{ face { edge 0 } { next-ring f } { base-face 0 } }
+ T{ face { edge 4 } { next-ring f } { base-face 1 } }
+ T{ face { edge 8 } { next-ring f } { base-face 2 } }
+ T{ face { edge 12 } { next-ring f } { base-face 3 } }
+ T{ face { edge 16 } { next-ring f } { base-face 4 } }
+ } }
+ { edges {
+ T{ b-edge { face 0 } { vertex 0 } { opposite-edge 6 } { next-edge 1 } }
+ T{ b-edge { face 0 } { vertex 1 } { opposite-edge 19 } { next-edge 2 } }
+ T{ b-edge { face 0 } { vertex 3 } { opposite-edge 12 } { next-edge 3 } }
+ T{ b-edge { face 0 } { vertex 2 } { opposite-edge f } { next-edge 0 } }
+
+ T{ b-edge { face 1 } { vertex 4 } { opposite-edge 10 } { next-edge 5 } }
+ T{ b-edge { face 1 } { vertex 5 } { opposite-edge 16 } { next-edge 6 } }
+ T{ b-edge { face 1 } { vertex 1 } { opposite-edge 0 } { next-edge 7 } }
+ T{ b-edge { face 1 } { vertex 0 } { opposite-edge f } { next-edge 4 } }
+
+ T{ b-edge { face 2 } { vertex 6 } { opposite-edge 14 } { next-edge 9 } }
+ T{ b-edge { face 2 } { vertex 7 } { opposite-edge 17 } { next-edge 10 } }
+ T{ b-edge { face 2 } { vertex 5 } { opposite-edge 4 } { next-edge 11 } }
+ T{ b-edge { face 2 } { vertex 4 } { opposite-edge f } { next-edge 8 } }
+
+ T{ b-edge { face 3 } { vertex 2 } { opposite-edge 2 } { next-edge 13 } }
+ T{ b-edge { face 3 } { vertex 3 } { opposite-edge f } { next-edge 14 } }
+ T{ b-edge { face 3 } { vertex 7 } { opposite-edge 8 } { next-edge 15 } }
+ T{ b-edge { face 3 } { vertex 6 } { opposite-edge 18 } { next-edge 12 } }
+
+ T{ b-edge { face 4 } { vertex 1 } { opposite-edge 5 } { next-edge 17 } }
+ T{ b-edge { face 4 } { vertex 5 } { opposite-edge 9 } { next-edge 18 } }
+ T{ b-edge { face 4 } { vertex 7 } { opposite-edge 13 } { next-edge 19 } }
+ T{ b-edge { face 4 } { vertex 3 } { opposite-edge 1 } { next-edge 16 } }
+ } }
+ { vertices {
+ T{ vertex { position double-4{ -1.0 -1.0 -1.0 0.0 } } { edge 0 } }
+ T{ vertex { position double-4{ -1.0 1.0 -1.0 0.0 } } { edge 1 } }
+ T{ vertex { position double-4{ 1.0 1.0 -1.0 0.0 } } { edge 3 } }
+ T{ vertex { position double-4{ 1.0 1.0 -1.0 0.0 } } { edge 2 } }
+ T{ vertex { position double-4{ -1.0 -1.0 1.0 0.0 } } { edge 4 } }
+ T{ vertex { position double-4{ -1.0 1.0 1.0 0.0 } } { edge 5 } }
+ T{ vertex { position double-4{ 1.0 1.0 1.0 0.0 } } { edge 8 } }
+ T{ vertex { position double-4{ 1.0 1.0 1.0 0.0 } } { edge 9 } }
+ } }
+ }
+
+CONSTANT: non-quad-face-cube-b-rep
+ T{ b-rep
+ { faces {
+ T{ face { edge 0 } { next-ring f } { base-face 0 } }
+ T{ face { edge 4 } { next-ring f } { base-face 1 } }
+ T{ face { edge 8 } { next-ring f } { base-face 2 } }
+ T{ face { edge 12 } { next-ring f } { base-face 3 } }
+ T{ face { edge 18 } { next-ring f } { base-face 4 } }
+ } }
+ { edges {
+ T{ b-edge { face 0 } { vertex 0 } { opposite-edge 6 } { next-edge 1 } }
+ T{ b-edge { face 0 } { vertex 1 } { opposite-edge 19 } { next-edge 2 } }
+ T{ b-edge { face 0 } { vertex 3 } { opposite-edge 12 } { next-edge 3 } }
+ T{ b-edge { face 0 } { vertex 2 } { opposite-edge 19 } { next-edge 0 } }
+
+ T{ b-edge { face 1 } { vertex 4 } { opposite-edge 10 } { next-edge 5 } }
+ T{ b-edge { face 1 } { vertex 5 } { opposite-edge 16 } { next-edge 6 } }
+ T{ b-edge { face 1 } { vertex 1 } { opposite-edge 0 } { next-edge 7 } }
+ T{ b-edge { face 1 } { vertex 0 } { opposite-edge 18 } { next-edge 4 } }
+
+ T{ b-edge { face 2 } { vertex 6 } { opposite-edge 14 } { next-edge 9 } }
+ T{ b-edge { face 2 } { vertex 7 } { opposite-edge 17 } { next-edge 10 } }
+ T{ b-edge { face 2 } { vertex 5 } { opposite-edge 4 } { next-edge 11 } }
+ T{ b-edge { face 2 } { vertex 4 } { opposite-edge 21 } { next-edge 8 } }
+
+ T{ b-edge { face 3 } { vertex 2 } { opposite-edge 2 } { next-edge 13 } }
+ T{ b-edge { face 3 } { vertex 3 } { opposite-edge 20 } { next-edge 16 } }
+ T{ b-edge { face 3 } { vertex 7 } { opposite-edge 8 } { next-edge 15 } }
+ T{ b-edge { face 3 } { vertex 6 } { opposite-edge 18 } { next-edge 12 } }
+ T{ b-edge { face 3 } { vertex 1 } { opposite-edge 5 } { next-edge 17 } }
+ T{ b-edge { face 3 } { vertex 5 } { opposite-edge 9 } { next-edge 14 } }
+
+ T{ b-edge { face 4 } { vertex 4 } { opposite-edge 7 } { next-edge 19 } }
+ T{ b-edge { face 4 } { vertex 0 } { opposite-edge 3 } { next-edge 20 } }
+ T{ b-edge { face 4 } { vertex 2 } { opposite-edge 15 } { next-edge 21 } }
+ T{ b-edge { face 4 } { vertex 6 } { opposite-edge 11 } { next-edge 18 } }
+ } }
+ { vertices {
+ T{ vertex { position double-4{ -1.0 -1.0 -1.0 0.0 } } { edge 0 } }
+ T{ vertex { position double-4{ -1.0 1.0 -1.0 0.0 } } { edge 1 } }
+ T{ vertex { position double-4{ 1.0 1.0 -1.0 0.0 } } { edge 3 } }
+ T{ vertex { position double-4{ 1.0 1.0 -1.0 0.0 } } { edge 2 } }
+ T{ vertex { position double-4{ -1.0 -1.0 1.0 0.0 } } { edge 4 } }
+ T{ vertex { position double-4{ -1.0 1.0 1.0 0.0 } } { edge 5 } }
+ T{ vertex { position double-4{ 1.0 1.0 1.0 0.0 } } { edge 8 } }
+ T{ vertex { position double-4{ 1.0 1.0 1.0 0.0 } } { edge 9 } }
+ } }
+ }
+
+CONSTANT: multi-ringed-face-cube-b-rep
+ T{ b-rep
+ { faces {
+ T{ face { edge 0 } { next-ring f } { base-face 0 } }
+ T{ face { edge 4 } { next-ring f } { base-face 1 } }
+ T{ face { edge 8 } { next-ring f } { base-face 2 } }
+ T{ face { edge 12 } { next-ring f } { base-face 3 } }
+ T{ face { edge 16 } { next-ring f } { base-face 4 } }
+ T{ face { edge 20 } { next-ring 6 } { base-face 5 } }
+ T{ face { edge 24 } { next-ring f } { base-face 5 } }
+ } }
+ { edges {
+ T{ b-edge { face 0 } { vertex 0 } { opposite-edge 6 } { next-edge 1 } }
+ T{ b-edge { face 0 } { vertex 1 } { opposite-edge 19 } { next-edge 2 } }
+ T{ b-edge { face 0 } { vertex 3 } { opposite-edge 12 } { next-edge 3 } }
+ T{ b-edge { face 0 } { vertex 2 } { opposite-edge 21 } { next-edge 0 } }
+
+ T{ b-edge { face 1 } { vertex 4 } { opposite-edge 10 } { next-edge 5 } }
+ T{ b-edge { face 1 } { vertex 5 } { opposite-edge 16 } { next-edge 6 } }
+ T{ b-edge { face 1 } { vertex 1 } { opposite-edge 0 } { next-edge 7 } }
+ T{ b-edge { face 1 } { vertex 0 } { opposite-edge 20 } { next-edge 4 } }
+
+ T{ b-edge { face 2 } { vertex 6 } { opposite-edge 14 } { next-edge 9 } }
+ T{ b-edge { face 2 } { vertex 7 } { opposite-edge 17 } { next-edge 10 } }
+ T{ b-edge { face 2 } { vertex 5 } { opposite-edge 4 } { next-edge 11 } }
+ T{ b-edge { face 2 } { vertex 4 } { opposite-edge 23 } { next-edge 8 } }
+
+ T{ b-edge { face 3 } { vertex 2 } { opposite-edge 2 } { next-edge 13 } }
+ T{ b-edge { face 3 } { vertex 3 } { opposite-edge 22 } { next-edge 14 } }
+ T{ b-edge { face 3 } { vertex 7 } { opposite-edge 8 } { next-edge 15 } }
+ T{ b-edge { face 3 } { vertex 6 } { opposite-edge 18 } { next-edge 12 } }
+
+ T{ b-edge { face 4 } { vertex 1 } { opposite-edge 5 } { next-edge 17 } }
+ T{ b-edge { face 4 } { vertex 5 } { opposite-edge 9 } { next-edge 18 } }
+ T{ b-edge { face 4 } { vertex 7 } { opposite-edge 13 } { next-edge 19 } }
+ T{ b-edge { face 4 } { vertex 3 } { opposite-edge 1 } { next-edge 16 } }
+
+ T{ b-edge { face 5 } { vertex 4 } { opposite-edge 7 } { next-edge 21 } }
+ T{ b-edge { face 5 } { vertex 0 } { opposite-edge 3 } { next-edge 22 } }
+ T{ b-edge { face 5 } { vertex 2 } { opposite-edge 15 } { next-edge 23 } }
+ T{ b-edge { face 5 } { vertex 6 } { opposite-edge 11 } { next-edge 20 } }
+
+ T{ b-edge { face 6 } { vertex 8 } { opposite-edge f } { next-edge 25 } }
+ T{ b-edge { face 6 } { vertex 9 } { opposite-edge f } { next-edge 26 } }
+ T{ b-edge { face 6 } { vertex 10 } { opposite-edge f } { next-edge 27 } }
+ T{ b-edge { face 6 } { vertex 11 } { opposite-edge f } { next-edge 24 } }
+ } }
+ { vertices {
+ T{ vertex { position double-4{ -1.0 -1.0 -1.0 0.0 } } { edge 0 } }
+ T{ vertex { position double-4{ -1.0 1.0 -1.0 0.0 } } { edge 1 } }
+ T{ vertex { position double-4{ 1.0 1.0 -1.0 0.0 } } { edge 3 } }
+ T{ vertex { position double-4{ 1.0 1.0 -1.0 0.0 } } { edge 2 } }
+ T{ vertex { position double-4{ -1.0 -1.0 1.0 0.0 } } { edge 4 } }
+ T{ vertex { position double-4{ -1.0 1.0 1.0 0.0 } } { edge 5 } }
+ T{ vertex { position double-4{ 1.0 1.0 1.0 0.0 } } { edge 8 } }
+ T{ vertex { position double-4{ 1.0 1.0 1.0 0.0 } } { edge 9 } }
+
+ T{ vertex { position double-4{ -1.0 -1.0 0.5 0.0 } } { edge 24 } }
+ T{ vertex { position double-4{ -1.0 -1.0 -0.5 0.0 } } { edge 25 } }
+ T{ vertex { position double-4{ 1.0 1.0 -0.5 0.0 } } { edge 26 } }
+ T{ vertex { position double-4{ 1.0 1.0 0.5 0.0 } } { edge 27 } }
+ } }
+ }
+
+CONSTANT: valid-multi-valence-b-rep
+ T{ b-rep
+ { edges {
+ T{ b-edge { face 0 } { vertex 23 } { opposite-edge 12 } { next-edge 1 } }
+ T{ b-edge { face 0 } { vertex 22 } { opposite-edge 8 } { next-edge 2 } }
+ T{ b-edge { face 0 } { vertex 20 } { opposite-edge 4 } { next-edge 3 } }
+ T{ b-edge { face 0 } { vertex 21 } { opposite-edge 16 } { next-edge 0 } }
+
+ T{ b-edge { face 1 } { vertex 21 } { opposite-edge 2 } { next-edge 5 } }
+ T{ b-edge { face 1 } { vertex 20 } { opposite-edge 11 } { next-edge 6 } }
+ T{ b-edge { face 1 } { vertex 16 } { opposite-edge 20 } { next-edge 7 } }
+ T{ b-edge { face 1 } { vertex 17 } { opposite-edge 17 } { next-edge 4 } }
+
+ T{ b-edge { face 2 } { vertex 20 } { opposite-edge 1 } { next-edge 9 } }
+ T{ b-edge { face 2 } { vertex 22 } { opposite-edge 15 } { next-edge 10 } }
+ T{ b-edge { face 2 } { vertex 18 } { opposite-edge 24 } { next-edge 11 } }
+ T{ b-edge { face 2 } { vertex 16 } { opposite-edge 5 } { next-edge 8 } }
+
+ T{ b-edge { face 3 } { vertex 22 } { opposite-edge 0 } { next-edge 13 } }
+ T{ b-edge { face 3 } { vertex 23 } { opposite-edge 19 } { next-edge 14 } }
+ T{ b-edge { face 3 } { vertex 19 } { opposite-edge 28 } { next-edge 15 } }
+ T{ b-edge { face 3 } { vertex 18 } { opposite-edge 9 } { next-edge 12 } }
+
+ T{ b-edge { face 4 } { vertex 23 } { opposite-edge 3 } { next-edge 17 } }
+ T{ b-edge { face 4 } { vertex 21 } { opposite-edge 7 } { next-edge 18 } }
+ T{ b-edge { face 4 } { vertex 17 } { opposite-edge 32 } { next-edge 19 } }
+ T{ b-edge { face 4 } { vertex 19 } { opposite-edge 13 } { next-edge 16 } }
+
+ T{ b-edge { face 5 } { vertex 17 } { opposite-edge 6 } { next-edge 21 } }
+ T{ b-edge { face 5 } { vertex 16 } { opposite-edge 27 } { next-edge 22 } }
+ T{ b-edge { face 5 } { vertex 0 } { opposite-edge 36 } { next-edge 23 } }
+ T{ b-edge { face 5 } { vertex 1 } { opposite-edge 33 } { next-edge 20 } }
+
+ T{ b-edge { face 6 } { vertex 16 } { opposite-edge 10 } { next-edge 25 } }
+ T{ b-edge { face 6 } { vertex 18 } { opposite-edge 31 } { next-edge 26 } }
+ T{ b-edge { face 6 } { vertex 2 } { opposite-edge 44 } { next-edge 27 } }
+ T{ b-edge { face 6 } { vertex 0 } { opposite-edge 21 } { next-edge 24 } }
+
+ T{ b-edge { face 7 } { vertex 18 } { opposite-edge 14 } { next-edge 29 } }
+ T{ b-edge { face 7 } { vertex 19 } { opposite-edge 35 } { next-edge 30 } }
+ T{ b-edge { face 7 } { vertex 3 } { opposite-edge 52 } { next-edge 31 } }
+ T{ b-edge { face 7 } { vertex 2 } { opposite-edge 25 } { next-edge 28 } }
+
+ T{ b-edge { face 8 } { vertex 19 } { opposite-edge 18 } { next-edge 33 } }
+ T{ b-edge { face 8 } { vertex 17 } { opposite-edge 23 } { next-edge 34 } }
+ T{ b-edge { face 8 } { vertex 1 } { opposite-edge 60 } { next-edge 35 } }
+ T{ b-edge { face 8 } { vertex 3 } { opposite-edge 29 } { next-edge 32 } }
+
+ T{ b-edge { face 9 } { vertex 1 } { opposite-edge 22 } { next-edge 37 } }
+ T{ b-edge { face 9 } { vertex 0 } { opposite-edge 43 } { next-edge 38 } }
+ T{ b-edge { face 9 } { vertex 8 } { opposite-edge 68 } { next-edge 39 } }
+ T{ b-edge { face 9 } { vertex 9 } { opposite-edge 65 } { next-edge 36 } }
+
+ T{ b-edge { face 10 } { vertex 0 } { opposite-edge 47 } { next-edge 41 } }
+ T{ b-edge { face 10 } { vertex 10 } { opposite-edge 73 } { next-edge 42 } }
+ T{ b-edge { face 10 } { vertex 24 } { opposite-edge 72 } { next-edge 43 } }
+ T{ b-edge { face 10 } { vertex 8 } { opposite-edge 37 } { next-edge 40 } }
+
+ T{ b-edge { face 11 } { vertex 0 } { opposite-edge 26 } { next-edge 45 } }
+ T{ b-edge { face 11 } { vertex 2 } { opposite-edge 51 } { next-edge 46 } }
+ T{ b-edge { face 11 } { vertex 12 } { opposite-edge 76 } { next-edge 47 } }
+ T{ b-edge { face 11 } { vertex 10 } { opposite-edge 40 } { next-edge 44 } }
+
+ T{ b-edge { face 12 } { vertex 2 } { opposite-edge 55 } { next-edge 49 } }
+ T{ b-edge { face 12 } { vertex 14 } { opposite-edge 81 } { next-edge 50 } }
+ T{ b-edge { face 12 } { vertex 26 } { opposite-edge 80 } { next-edge 51 } }
+ T{ b-edge { face 12 } { vertex 12 } { opposite-edge 45 } { next-edge 48 } }
+
+ T{ b-edge { face 13 } { vertex 2 } { opposite-edge 30 } { next-edge 53 } }
+ T{ b-edge { face 13 } { vertex 3 } { opposite-edge 59 } { next-edge 54 } }
+ T{ b-edge { face 13 } { vertex 15 } { opposite-edge 84 } { next-edge 55 } }
+ T{ b-edge { face 13 } { vertex 14 } { opposite-edge 48 } { next-edge 52 } }
+
+ T{ b-edge { face 14 } { vertex 3 } { opposite-edge 63 } { next-edge 57 } }
+ T{ b-edge { face 14 } { vertex 13 } { opposite-edge 89 } { next-edge 58 } }
+ T{ b-edge { face 14 } { vertex 27 } { opposite-edge 88 } { next-edge 59 } }
+ T{ b-edge { face 14 } { vertex 15 } { opposite-edge 53 } { next-edge 56 } }
+
+ T{ b-edge { face 15 } { vertex 3 } { opposite-edge 34 } { next-edge 61 } }
+ T{ b-edge { face 15 } { vertex 1 } { opposite-edge 64 } { next-edge 62 } }
+ T{ b-edge { face 15 } { vertex 11 } { opposite-edge 92 } { next-edge 63 } }
+ T{ b-edge { face 15 } { vertex 13 } { opposite-edge 56 } { next-edge 60 } }
+
+ T{ b-edge { face 16 } { vertex 11 } { opposite-edge 61 } { next-edge 65 } }
+ T{ b-edge { face 16 } { vertex 1 } { opposite-edge 39 } { next-edge 66 } }
+ T{ b-edge { face 16 } { vertex 9 } { opposite-edge 97 } { next-edge 67 } }
+ T{ b-edge { face 16 } { vertex 25 } { opposite-edge 96 } { next-edge 64 } }
+
+ T{ b-edge { face 17 } { vertex 9 } { opposite-edge 38 } { next-edge 69 } }
+ T{ b-edge { face 17 } { vertex 8 } { opposite-edge 75 } { next-edge 70 } }
+ T{ b-edge { face 17 } { vertex 4 } { opposite-edge 102 } { next-edge 71 } }
+ T{ b-edge { face 17 } { vertex 5 } { opposite-edge 98 } { next-edge 68 } }
+
+ T{ b-edge { face 18 } { vertex 8 } { opposite-edge 42 } { next-edge 73 } }
+ T{ b-edge { face 18 } { vertex 24 } { opposite-edge 41 } { next-edge 74 } }
+ T{ b-edge { face 18 } { vertex 10 } { opposite-edge 79 } { next-edge 75 } }
+ T{ b-edge { face 18 } { vertex 4 } { opposite-edge 69 } { next-edge 72 } }
+
+ T{ b-edge { face 19 } { vertex 10 } { opposite-edge 46 } { next-edge 77 } }
+ T{ b-edge { face 19 } { vertex 12 } { opposite-edge 83 } { next-edge 78 } }
+ T{ b-edge { face 19 } { vertex 6 } { opposite-edge 103 } { next-edge 79 } }
+ T{ b-edge { face 19 } { vertex 4 } { opposite-edge 74 } { next-edge 76 } }
+
+ T{ b-edge { face 20 } { vertex 12 } { opposite-edge 50 } { next-edge 81 } }
+ T{ b-edge { face 20 } { vertex 26 } { opposite-edge 49 } { next-edge 82 } }
+ T{ b-edge { face 20 } { vertex 14 } { opposite-edge 87 } { next-edge 83 } }
+ T{ b-edge { face 20 } { vertex 6 } { opposite-edge 77 } { next-edge 80 } }
+
+ T{ b-edge { face 21 } { vertex 14 } { opposite-edge 54 } { next-edge 85 } }
+ T{ b-edge { face 21 } { vertex 15 } { opposite-edge 91 } { next-edge 86 } }
+ T{ b-edge { face 21 } { vertex 7 } { opposite-edge 100 } { next-edge 87 } }
+ T{ b-edge { face 21 } { vertex 6 } { opposite-edge 82 } { next-edge 84 } }
+
+ T{ b-edge { face 22 } { vertex 15 } { opposite-edge 58 } { next-edge 89 } }
+ T{ b-edge { face 22 } { vertex 27 } { opposite-edge 57 } { next-edge 90 } }
+ T{ b-edge { face 22 } { vertex 13 } { opposite-edge 95 } { next-edge 91 } }
+ T{ b-edge { face 22 } { vertex 7 } { opposite-edge 85 } { next-edge 88 } }
+
+ T{ b-edge { face 23 } { vertex 13 } { opposite-edge 62 } { next-edge 93 } }
+ T{ b-edge { face 23 } { vertex 11 } { opposite-edge 99 } { next-edge 94 } }
+ T{ b-edge { face 23 } { vertex 5 } { opposite-edge 101 } { next-edge 95 } }
+ T{ b-edge { face 23 } { vertex 7 } { opposite-edge 90 } { next-edge 92 } }
+
+ T{ b-edge { face 24 } { vertex 11 } { opposite-edge 67 } { next-edge 97 } }
+ T{ b-edge { face 24 } { vertex 25 } { opposite-edge 66 } { next-edge 98 } }
+ T{ b-edge { face 24 } { vertex 9 } { opposite-edge 71 } { next-edge 99 } }
+ T{ b-edge { face 24 } { vertex 5 } { opposite-edge 93 } { next-edge 96 } }
+
+ T{ b-edge { face 25 } { vertex 6 } { opposite-edge 86 } { next-edge 101 } }
+ T{ b-edge { face 25 } { vertex 7 } { opposite-edge 94 } { next-edge 102 } }
+ T{ b-edge { face 25 } { vertex 5 } { opposite-edge 70 } { next-edge 103 } }
+ T{ b-edge { face 25 } { vertex 4 } { opposite-edge 78 } { next-edge 100 } }
+ } }
+ { vertices {
+ T{ vertex { position double-4{ 1.0 1.0 1.0 0.0 } } { edge 37 } }
+ T{ vertex { position double-4{ 1.0 1.0 -1.0 0.0 } } { edge 36 } }
+ T{ vertex { position double-4{ 1.0 -1.0 1.0 0.0 } } { edge 52 } }
+ T{ vertex { position double-4{ 1.0 -1.0 -1.0 0.0 } } { edge 53 } }
+
+ T{ vertex { position double-4{ 3.0 1.0 1.0 0.0 } } { edge 70 } }
+ T{ vertex { position double-4{ 3.0 1.0 -1.0 0.0 } } { edge 71 } }
+ T{ vertex { position double-4{ 3.0 -1.0 1.0 0.0 } } { edge 87 } }
+ T{ vertex { position double-4{ 3.0 -1.0 -1.0 0.0 } } { edge 86 } }
+
+ T{ vertex { position double-4{ 2.0 2.0 1.0 0.0 } } { edge 38 } }
+ T{ vertex { position double-4{ 2.0 2.0 -1.0 0.0 } } { edge 39 } }
+ T{ vertex { position double-4{ 2.0 1.0 2.0 0.0 } } { edge 47 } }
+ T{ vertex { position double-4{ 2.0 1.0 -2.0 0.0 } } { edge 62 } }
+
+ T{ vertex { position double-4{ 2.0 -1.0 2.0 0.0 } } { edge 51 } }
+ T{ vertex { position double-4{ 2.0 -1.0 -2.0 0.0 } } { edge 57 } }
+ T{ vertex { position double-4{ 2.0 -2.0 1.0 0.0 } } { edge 55 } }
+ T{ vertex { position double-4{ 2.0 -2.0 -1.0 0.0 } } { edge 54 } }
+
+ T{ vertex { position double-4{ -1.0 1.0 1.0 0.0 } } { edge 6 } }
+ T{ vertex { position double-4{ -1.0 1.0 -1.0 0.0 } } { edge 7 } }
+ T{ vertex { position double-4{ -1.0 -1.0 1.0 0.0 } } { edge 15 } }
+ T{ vertex { position double-4{ -1.0 -1.0 -1.0 0.0 } } { edge 14 } }
+
+ T{ vertex { position double-4{ -2.0 1.0 1.0 0.0 } } { edge 2 } }
+ T{ vertex { position double-4{ -2.0 1.0 -1.0 0.0 } } { edge 3 } }
+ T{ vertex { position double-4{ -2.0 -1.0 1.0 0.0 } } { edge 1 } }
+ T{ vertex { position double-4{ -2.0 -1.0 -1.0 0.0 } } { edge 0 } }
+
+ T{ vertex { position double-4{ 2.0 2.0 2.0 0.0 } } { edge 42 } }
+ T{ vertex { position double-4{ 2.0 2.0 -2.0 0.0 } } { edge 67 } }
+ T{ vertex { position double-4{ 2.0 -2.0 2.0 0.0 } } { edge 50 } }
+ T{ vertex { position double-4{ 2.0 -2.0 -2.0 0.0 } } { edge 58 } }
+ } }
+ { faces {
+ T{ face { edge 0 } { next-ring f } { base-face 0 } }
+ T{ face { edge 4 } { next-ring f } { base-face 1 } }
+ T{ face { edge 8 } { next-ring f } { base-face 2 } }
+ T{ face { edge 12 } { next-ring f } { base-face 3 } }
+ T{ face { edge 16 } { next-ring f } { base-face 4 } }
+ T{ face { edge 20 } { next-ring f } { base-face 5 } }
+ T{ face { edge 24 } { next-ring f } { base-face 6 } }
+ T{ face { edge 28 } { next-ring f } { base-face 7 } }
+ T{ face { edge 32 } { next-ring f } { base-face 8 } }
+ T{ face { edge 36 } { next-ring f } { base-face 9 } }
+ T{ face { edge 40 } { next-ring f } { base-face 10 } }
+ T{ face { edge 44 } { next-ring f } { base-face 11 } }
+ T{ face { edge 48 } { next-ring f } { base-face 12 } }
+ T{ face { edge 52 } { next-ring f } { base-face 13 } }
+ T{ face { edge 56 } { next-ring f } { base-face 14 } }
+ T{ face { edge 60 } { next-ring f } { base-face 15 } }
+ T{ face { edge 64 } { next-ring f } { base-face 16 } }
+ T{ face { edge 68 } { next-ring f } { base-face 17 } }
+ T{ face { edge 72 } { next-ring f } { base-face 18 } }
+ T{ face { edge 76 } { next-ring f } { base-face 19 } }
+ T{ face { edge 80 } { next-ring f } { base-face 20 } }
+ T{ face { edge 84 } { next-ring f } { base-face 21 } }
+ T{ face { edge 88 } { next-ring f } { base-face 22 } }
+ T{ face { edge 92 } { next-ring f } { base-face 23 } }
+ T{ face { edge 96 } { next-ring f } { base-face 24 } }
+ T{ face { edge 100 } { next-ring f } { base-face 25 } }
+ } }
+ }
+
+CONSTANT: degenerate-incomplete-face
+ T{ b-rep
+ { edges {
+ T{ b-edge { face 0 } { vertex 0 } { opposite-edge 5 } { next-edge 1 } }
+ T{ b-edge { face 0 } { vertex 1 } { opposite-edge 4 } { next-edge 2 } }
+ T{ b-edge { face 0 } { vertex 2 } { opposite-edge 3 } { next-edge 3 } }
+ T{ b-edge { face 0 } { vertex 3 } { opposite-edge 2 } { next-edge 4 } }
+ T{ b-edge { face 0 } { vertex 2 } { opposite-edge 1 } { next-edge 5 } }
+ T{ b-edge { face 0 } { vertex 1 } { opposite-edge 0 } { next-edge 0 } }
+ } }
+ { vertices {
+ T{ vertex { position double-4{ -1 -1 0 0 } } { edge 0 } }
+ T{ vertex { position double-4{ 1 -1 0 0 } } { edge 1 } }
+ T{ vertex { position double-4{ 1 1 0 0 } } { edge 2 } }
+ T{ vertex { position double-4{ -1 1 0 0 } } { edge 3 } }
+ } }
+ { faces {
+ T{ face { edge 0 } { next-ring f } { base-face 0 } }
+ } }
+ }
+
+CONSTANT: partially-degenerate-second-face
+ T{ b-rep
+ { edges {
+ T{ b-edge { face 0 } { vertex 0 } { opposite-edge 6 } { next-edge 1 } }
+ T{ b-edge { face 0 } { vertex 1 } { opposite-edge 5 } { next-edge 2 } }
+ T{ b-edge { face 0 } { vertex 2 } { opposite-edge 4 } { next-edge 3 } }
+ T{ b-edge { face 0 } { vertex 3 } { opposite-edge 9 } { next-edge 0 } }
+
+ T{ b-edge { face 1 } { vertex 3 } { opposite-edge 2 } { next-edge 5 } }
+ T{ b-edge { face 1 } { vertex 2 } { opposite-edge 1 } { next-edge 6 } }
+ T{ b-edge { face 1 } { vertex 1 } { opposite-edge 0 } { next-edge 7 } }
+ T{ b-edge { face 1 } { vertex 0 } { opposite-edge 8 } { next-edge 8 } }
+ T{ b-edge { face 1 } { vertex 4 } { opposite-edge 7 } { next-edge 9 } }
+ T{ b-edge { face 1 } { vertex 0 } { opposite-edge 3 } { next-edge 4 } }
+ } }
+ { vertices {
+ T{ vertex { position double-4{ -1 -1 0 0 } } { edge 0 } }
+ T{ vertex { position double-4{ 1 -1 0 0 } } { edge 1 } }
+ T{ vertex { position double-4{ 1 1 0 0 } } { edge 2 } }
+ T{ vertex { position double-4{ -1 1 0 0 } } { edge 3 } }
+ T{ vertex { position double-4{ -2 -2 0 0 } } { edge 8 } }
+ } }
+ { faces {
+ T{ face { edge 0 } { next-ring f } { base-face 0 } }
+ T{ face { edge 4 } { next-ring f } { base-face 1 } }
+ } }
+ }
+
+: nth-when ( index/f seq -- elt/f )
+ over [ nth ] [ 2drop f ] if ; inline
+
+:: connect-b-rep ( b-rep -- )
+ b-rep faces>> [
+ [ b-rep edges>> nth-when ] change-edge
+ [ b-rep faces>> nth-when ] change-next-ring
+ [ b-rep faces>> nth-when ] change-base-face
+ drop
+ ] each
+
+ b-rep vertices>> [
+ [ b-rep edges>> nth-when ] change-edge
+ drop
+ ] each
+
+ b-rep edges>> [
+ [ b-rep faces>> nth-when ] change-face
+ [ b-rep vertices>> nth-when ] change-vertex
+ [ b-rep edges>> nth-when ] change-opposite-edge
+ [ b-rep edges>> nth-when ] change-next-edge
+ drop
+ ] each ;
+
+:: disconnect-b-rep ( b-rep -- )
+ b-rep faces>> >index-hash :> face-indices
+ b-rep edges>> >index-hash :> edge-indices
+ b-rep vertices>> >index-hash :> vertex-indices
+
+ b-rep faces>> [
+ [ edge-indices at ] change-edge
+ [ face-indices at ] change-next-ring
+ [ face-indices at ] change-base-face
+ drop
+ ] each
+
+ b-rep vertices>> [
+ [ edge-indices at ] change-edge
+ drop
+ ] each
+
+ b-rep edges>> [
+ [ face-indices at ] change-face
+ [ vertex-indices at ] change-vertex
+ [ edge-indices at ] change-opposite-edge
+ [ edge-indices at ] change-next-edge
+ drop
+ ] each ;
+
+valid-cube-b-rep connect-b-rep
+missing-face-cube-b-rep connect-b-rep
+non-quad-face-cube-b-rep connect-b-rep
+multi-ringed-face-cube-b-rep connect-b-rep
+valid-multi-valence-b-rep connect-b-rep
+degenerate-incomplete-face connect-b-rep
+partially-degenerate-second-face connect-b-rep
--- /dev/null
+! (c) 2010 Joe Groff bsd license
+USING: euler.b-rep euler.b-rep.examples euler.b-rep.io.obj
+io.streams.string literals math.vectors.simd.cords tools.test ;
+IN: euler.b-rep.io.obj.tests
+
+CONSTANT: valid-cube-obj
+"""v -1.0 -1.0 -1.0
+v -1.0 1.0 -1.0
+v 1.0 -1.0 -1.0
+v 1.0 1.0 -1.0
+v -1.0 -1.0 1.0
+v -1.0 1.0 1.0
+v 1.0 -1.0 1.0
+v 1.0 1.0 1.0
+f 1 2 4 3
+f 5 6 2 1
+f 7 8 6 5
+f 3 4 8 7
+f 2 6 8 4
+f 5 1 3 7
+"""
+
+CONSTANT: valid-cube-obj-relative-indices
+"""v -1.0 -1.0 -1.0
+v -1.0 1.0 -1.0
+v 1.0 -1.0 -1.0
+v 1.0 1.0 -1.0
+f -4 -3 -1 -2
+v -1.0 -1.0 1.0
+v -1.0 1.0 1.0
+v 1.0 -1.0 1.0
+v 1.0 1.0 1.0
+f -4 -3 -7 -8
+f 7 8 6 5
+f 3 4 8 7
+f 2 6 8 4
+f 5 1 3 7
+"""
+
+CONSTANT: valid-cube-obj-texcoords
+"""# comment should be ignored
+v -1.0 -1.0 -1.0
+v -1.0 1.0 -1.0
+v 1.0 -1.0 -1.0
+v 1.0 1.0 -1.0
+v -1.0 -1.0 1.0
+v -1.0 1.0 1.0
+v 1.0 -1.0 1.0
+v 1.0 1.0 1.0
+vt 0 0
+vt 0 1
+vt 1 0
+vt 1 1
+f 1/1 2/2 4/4 3/3
+f 5/1 6/2 2/2 1/1
+f 7/3 8/4 6/2 5/1
+f 3/3 4/4 8/4 7/3
+f 2/2 6/2 8/4 4/4
+f 5/1 1/1 3/3 7/3
+"""
+
+{ $ valid-cube-obj } [ [ valid-cube-b-rep write-obj ] with-string-writer ] unit-test
+
+{
+ V{
+ double-4{ -1.0 -1.0 -1.0 0.0 }
+ double-4{ -1.0 1.0 -1.0 0.0 }
+ double-4{ 1.0 -1.0 -1.0 0.0 }
+ double-4{ 1.0 1.0 -1.0 0.0 }
+ double-4{ -1.0 -1.0 1.0 0.0 }
+ double-4{ -1.0 1.0 1.0 0.0 }
+ double-4{ 1.0 -1.0 1.0 0.0 }
+ double-4{ 1.0 1.0 1.0 0.0 }
+ }
+ V{
+ { 0 1 3 2 }
+ { 4 5 1 0 }
+ { 6 7 5 4 }
+ { 2 3 7 6 }
+ { 1 5 7 3 }
+ { 4 0 2 6 }
+ }
+} [
+ valid-cube-obj [ (read-obj) ] with-string-reader
+] unit-test
+
+{
+ V{
+ double-4{ -1.0 -1.0 -1.0 0.0 }
+ double-4{ -1.0 1.0 -1.0 0.0 }
+ double-4{ 1.0 -1.0 -1.0 0.0 }
+ double-4{ 1.0 1.0 -1.0 0.0 }
+ double-4{ -1.0 -1.0 1.0 0.0 }
+ double-4{ -1.0 1.0 1.0 0.0 }
+ double-4{ 1.0 -1.0 1.0 0.0 }
+ double-4{ 1.0 1.0 1.0 0.0 }
+ }
+ V{
+ { 0 1 3 2 }
+ { 4 5 1 0 }
+ { 6 7 5 4 }
+ { 2 3 7 6 }
+ { 1 5 7 3 }
+ { 4 0 2 6 }
+ }
+} [
+ valid-cube-obj-relative-indices [ (read-obj) ] with-string-reader
+] unit-test
+
+{
+ V{
+ double-4{ -1.0 -1.0 -1.0 0.0 }
+ double-4{ -1.0 1.0 -1.0 0.0 }
+ double-4{ 1.0 -1.0 -1.0 0.0 }
+ double-4{ 1.0 1.0 -1.0 0.0 }
+ double-4{ -1.0 -1.0 1.0 0.0 }
+ double-4{ -1.0 1.0 1.0 0.0 }
+ double-4{ 1.0 -1.0 1.0 0.0 }
+ double-4{ 1.0 1.0 1.0 0.0 }
+ }
+ V{
+ { 0 1 3 2 }
+ { 4 5 1 0 }
+ { 6 7 5 4 }
+ { 2 3 7 6 }
+ { 1 5 7 3 }
+ { 4 0 2 6 }
+ }
+} [
+ valid-cube-obj-texcoords [ (read-obj) ] with-string-reader
+] unit-test
--- /dev/null
+! (c) 2010 Joe Groff bsd license
+USING: accessors assocs combinators euler.b-rep fry
+game.models.half-edge grouping io kernel locals math
+math.parser math.vectors.simd.cords sequences splitting ;
+IN: euler.b-rep.io.obj
+
+<PRIVATE
+: write-obj-vertex ( vertex -- )
+ "v " write
+ position>> 3 head-slice [ bl ] [ number>string write ] interleave nl ;
+
+: write-obj-face ( face vx-indices -- )
+ "f" write
+ [ edge>> ] dip '[ bl vertex>> _ at 1 + number>string write ] each-face-edge nl ;
+PRIVATE>
+
+:: write-obj ( b-rep -- )
+ b-rep vertices>> :> vertices
+ vertices >index-hash :> vx-indices
+
+ vertices [ write-obj-vertex ] each
+ b-rep faces>> [ vx-indices write-obj-face ] each ;
+
+<PRIVATE
+:: reconstruct-face ( face-vertices vertices -- face edges )
+ face new
+ dup >>base-face
+ :> face
+ face-vertices [
+ vertices nth :> vertex
+ b-edge new
+ vertex >>vertex
+ face >>face
+ :> edge
+ vertex [ [ edge ] unless* ] change-edge drop
+ edge
+ ] { } map-as :> edges
+
+ edges 1 edges length 1 + edges <circular-slice> [ >>next-edge drop ] 2each
+ face edges first >>edge
+ edges ;
+
+:: reconstruct-b-rep ( vertex-positions faces-vertices -- b-rep )
+ vertex-positions [ vertex new swap >>position ] { } map-as :> vertices
+ V{ } clone :> edges
+ faces-vertices [ vertices reconstruct-face edges push-all ] { } map-as :> faces
+
+ b-rep new
+ faces >>faces
+ edges >>edges
+ vertices >>vertices
+ dup connect-opposite-edges ;
+
+: parse-vertex ( line -- position )
+ " " split first3 [ string>number >float ] tri@ 0.0 double-4-boa ;
+
+: read-vertex ( line vertices -- )
+ [ parse-vertex ] dip push ;
+
+: parse-face-index ( token vertices -- index )
+ swap "/" split1 drop string>number
+ dup 0 >= [ nip 1 - ] [ [ length ] dip + ] if ;
+
+: parse-face ( line vertices -- vertices )
+ [ " " split ] dip '[ _ parse-face-index ] map ;
+
+: read-face ( line vertices faces -- )
+ [ parse-face ] dip push ;
+
+PRIVATE>
+
+:: (read-obj) ( -- vertices faces )
+ V{ } clone :> vertices
+ V{ } clone :> faces
+ [
+ " " split1 swap {
+ { "#" [ drop ] }
+ { "v" [ vertices read-vertex ] }
+ { "f" [ vertices faces read-face ] }
+ [ 2drop ]
+ } case
+ ] each-line
+ vertices faces ;
+
+:: read-obj ( -- b-rep )
+ (read-obj) reconstruct-b-rep ;
--- /dev/null
+USING: accessors arrays assocs euler.b-rep
+game.models.half-edge kernel locals math math.vectors
+math.vectors.simd.cords sequences sets typed fry ;
+FROM: sequences.private => nth-unsafe set-nth-unsafe ;
+IN: euler.b-rep.subdivision
+
+: <vertex> ( position -- vertex ) vertex new swap >>position ; inline
+
+: face-points ( faces -- face-pts )
+ [ edge>> face-midpoint <vertex> ] map ; inline
+
+:: edge-points ( edges edge-indices face-indices face-points -- edge-pts )
+ edges length 0 <array> :> edge-pts
+
+ edges [| edge n |
+ edge opposite-edge>> :> opposite-edge
+ opposite-edge edge-indices at :> opposite-n
+
+ n opposite-n < [
+ edge vertex>> position>>
+ opposite-edge vertex>> position>> v+
+ edge face>> face-indices at face-points nth position>> v+
+ opposite-edge face>> face-indices at face-points nth position>> v+
+ 0.25 v*n
+ <vertex>
+ [ n edge-pts set-nth-unsafe ]
+ [ opposite-n edge-pts set-nth-unsafe ] bi
+ ] when
+ ] each-index
+
+ edge-pts ; inline
+
+:: vertex-points ( vertices edge-indices face-indices edge-pts face-points -- vertex-pts )
+ vertices [| vertex |
+ 0 double-4{ 0 0 0 0 } double-4{ 0 0 0 0 }
+ vertex edge>> [| valence face-sum edge-sum edge |
+ valence 1 +
+ face-sum edge face>> face-indices at face-points nth position>> v+
+ edge-sum edge next-edge>> vertex>> position>> v+
+ ] each-vertex-edge :> ( valence face-sum edge-sum )
+ valence >float :> fvalence
+ face-sum fvalence v/n :> face-avg
+ edge-sum fvalence v/n :> edge-avg
+ face-avg edge-avg v+ vertex position>> fvalence 2.0 - v*n v+
+ fvalence v/n
+ <vertex>
+ ] map ; inline
+
+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 [ edg-b or ] change-edge drop
+ point-c [ edg-c or ] change-edge drop
+ point-d [ edg-d or ] change-edge drop
+ ] 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 ;
--- /dev/null
+USING: accessors arrays euler.b-rep.examples
+euler.b-rep.triangulation math.vectors.simd.cords sequences
+tools.test gml kernel ;
+IN: euler.b-rep.triangulation.tests
+
+: triangle-vx-positions ( triangles -- positions )
+ [ [ position>> ] { } map-as ] { } map-as ;
+
+{
+ {
+ {
+ double-4{ 1.0 1.0 -1.0 0.0 }
+ double-4{ -1.0 -1.0 -1.0 0.0 }
+ double-4{ -1.0 1.0 -1.0 0.0 }
+ }
+ {
+ double-4{ -1.0 -1.0 -1.0 0.0 }
+ double-4{ 1.0 1.0 -1.0 0.0 }
+ double-4{ 1.0 -1.0 -1.0 0.0 }
+ }
+ }
+} [ valid-cube-b-rep faces>> first triangulate-face triangle-vx-positions ] unit-test
+
+{ { } } [ degenerate-incomplete-face faces>> first triangulate-face triangle-vx-positions ] unit-test
+{ {
+ {
+ double-4{ 1.0 1.0 0.0 0.0 }
+ double-4{ -1.0 -1.0 0.0 0.0 }
+ double-4{ -1.0 1.0 0.0 0.0 }
+ }
+ {
+ double-4{ -1.0 -1.0 0.0 0.0 }
+ double-4{ 1.0 1.0 0.0 0.0 }
+ double-4{ 1.0 -1.0 0.0 0.0 }
+ }
+} } [ partially-degenerate-second-face faces>> second triangulate-face triangle-vx-positions ] unit-test
+
+{
+ {
+ {
+ double-4{ -1.0 1.0 0.0 0.0 }
+ double-4{ -0.5 0.5 0.0 0.0 }
+ double-4{ -1.0 -1.0 0.0 0.0 }
+ }
+ {
+ double-4{ -0.5 0.5 0.0 0.0 }
+ double-4{ -1.0 1.0 0.0 0.0 }
+ double-4{ 1.0 1.0 0.0 0.0 }
+ }
+ {
+ double-4{ -0.5 0.5 0.0 0.0 }
+ double-4{ 1.0 1.0 0.0 0.0 }
+ double-4{ 0.5 0.5 0.0 0.0 }
+ }
+ {
+ double-4{ 0.5 0.5 0.0 0.0 }
+ double-4{ 1.0 1.0 0.0 0.0 }
+ double-4{ 0.5 -0.5 0.0 0.0 }
+ }
+ {
+ double-4{ -1.0 -1.0 0.0 0.0 }
+ double-4{ -0.5 -0.5 0.0 0.0 }
+ double-4{ 1.0 -1.0 0.0 0.0 }
+ }
+ {
+ double-4{ -0.5 -0.5 0.0 0.0 }
+ double-4{ -1.0 -1.0 0.0 0.0 }
+ double-4{ -0.5 0.5 0.0 0.0 }
+ }
+ {
+ double-4{ 1.0 -1.0 0.0 0.0 }
+ double-4{ -0.5 -0.5 0.0 0.0 }
+ double-4{ 0.5 -0.5 0.0 0.0 }
+ }
+ {
+ double-4{ 1.0 -1.0 0.0 0.0 }
+ double-4{ 0.5 -0.5 0.0 0.0 }
+ double-4{ 1.0 1.0 0.0 0.0 }
+ }
+ }
+} [
+ [ "vocab:gml/examples/torus.gml" run-gml-file ] make-gml nip
+ faces>> first triangulate-face triangle-vx-positions
+] unit-test
--- /dev/null
+USING: accessors alien.c-types alien.handles euler.b-rep
+game.models.half-edge grouping kernel locals opengl.gl
+opengl.glu sequences specialized-arrays specialized-vectors
+libc destructors alien.data ;
+IN: euler.b-rep.triangulation
+
+SPECIALIZED-ARRAY: double
+
+ERROR: triangulated-face-must-be-base ;
+
+<PRIVATE
+
+: tess-begin ( -- callback )
+ [| primitive-type vertices-h |
+ primitive-type GL_TRIANGLES =
+ [ "unexpected primitive type" throw ] unless
+ ] GLUtessBeginDataCallback ;
+
+: tess-end ( -- callback )
+ [| vertices-h |
+ ! nop
+ ] GLUtessEndDataCallback ;
+
+: tess-vertex ( -- callback )
+ [| vertex-h vertices-h |
+ vertex-h alien-handle-ptr>
+ vertices-h alien-handle-ptr> push
+ ] GLUtessVertexDataCallback ;
+
+: tess-edge-flag ( -- callback )
+ [| flag vertices-h |
+ ! nop
+ ] GLUtessEdgeFlagDataCallback ;
+
+PRIVATE>
+
+:: triangulate-face ( face -- triangles )
+ [
+ face dup base-face>> eq? [ triangulated-face-must-be-base ] unless
+
+ gluNewTess &gluDeleteTess :> tess
+ V{ } clone :> vertices
+ vertices <alien-handle-ptr> &release-alien-handle-ptr :> vertices-h
+
+ tess GLU_TESS_BEGIN_DATA tess-begin gluTessCallback
+ tess GLU_TESS_END_DATA tess-end gluTessCallback
+ tess GLU_TESS_VERTEX_DATA tess-vertex gluTessCallback
+ tess GLU_TESS_EDGE_FLAG_DATA tess-edge-flag gluTessCallback
+
+ tess vertices-h gluTessBeginPolygon
+
+ 4 double malloc-array &free :> vertex-buf
+
+ face [| ring |
+ tess gluTessBeginContour
+
+ ring edge>> [
+ tess swap vertex>>
+ [ position>> double >c-array ]
+ [ <alien-handle-ptr> &release-alien-handle-ptr ] bi gluTessVertex
+ ] each-face-edge
+
+ tess gluTessEndContour
+
+ ring next-ring>> dup
+ ] loop drop
+ tess gluTessEndPolygon
+
+ vertices { } like 3 <groups>
+ ] with-destructors ;
--- /dev/null
+USING: accessors kernel tools.test euler.b-rep euler.operators
+euler.modeling game.models.half-edge ;
+IN: euler.modeling.tests
+
+! polygon>double-face
+{ } [
+ [
+ { { -1 -1 0 } { 1 -1 0 } { 1 1 0 } { -1 1 0 } }
+ smooth-smooth polygon>double-face
+ [ face-sides 4 assert= ]
+ [ opposite-edge>> face-sides 4 assert= ]
+ [ face-normal { 0.0 0.0 1.0 } assert= ]
+ tri
+ ] make-b-rep check-b-rep
+] unit-test
+
+! extrude-simple
+{ } [
+ [
+ { { -1 -1 0 } { 1 -1 0 } { 1 1 0 } }
+ smooth-smooth polygon>double-face
+ 1 f extrude-simple
+ [ face-sides 3 assert= ]
+ [ opposite-edge>> face-sides 4 assert= ]
+ bi
+ ] make-b-rep check-b-rep
+] unit-test
+
+! project-pt-line
+{ { 0 1 0 } } [ { 0 0 0 } { 0 1 0 } { 1 1 0 } project-pt-line ] unit-test
+{ { 0 1 0 } } [ { 0 0 0 } { 1 1 0 } { 0 1 0 } project-pt-line ] unit-test
+{ { 0 1 0 } } [ { 0 0 0 } { 2 1 0 } { 1 1 0 } project-pt-line ] unit-test
+{ { -1 1 0 } } [ { -1 0 0 } { 2 1 0 } { 1 1 0 } project-pt-line ] unit-test
+{ { 1/2 1/2 0 } } [ { 0 0 0 } { 0 1 0 } { 1 0 0 } project-pt-line ] unit-test
+
+! project-pt-plane
+{ { 0 0 1 } } [ { 0 0 0 } { 0 0 1 } { 0 0 1 } -1 project-pt-plane ] unit-test
+{ { 0 0 -1 } } [ { 0 0 0 } { 0 0 1 } { 0 0 1 } 1 project-pt-plane ] unit-test
+{ { 0 0 3 } } [ { 0 0 0 } { 0 0 1 } { 0 0 1 } -3 project-pt-plane ] unit-test
+{ { 0 0 3 } } [ { 0 0 0 } { 0 0 1 } { 0 0 -1 } 3 project-pt-plane ] unit-test
+{ { 0 0 1 } } [ { 0 0 0 } { 0 0 1 } { 0 1 1 } -1 project-pt-plane ] unit-test
+
+{ { 0 2/3 1/3 } } [ { 0 0 0 } { 0 2 1 } { 0 1 1 } -1 project-pt-plane ] unit-test
+
+{ { 0 0 1 } } [ { 0 0 0 } { 0 0 1/2 } { 0 0 1 } -1 project-pt-plane ] unit-test
+{ { 0 1 1 } } [ { 0 0 0 } { 0 1/2 1/2 } { 0 0 1 } -1 project-pt-plane ] unit-test
--- /dev/null
+! Copyright (C) 2010 Slava Pestov.
+USING: accessors combinators fry kernel locals math.vectors
+namespaces sets sequences game.models.half-edge euler.b-rep
+euler.operators math ;
+IN: euler.modeling
+
+: (polygon>double-face) ( polygon -- edge )
+ [ first2 make-vefs ] keep
+ [ drop opposite-edge>> ] [ 2 tail-slice [ make-ev-one ] each ] 2bi
+ make-ef face-ccw ;
+
+SYMBOLS: smooth-smooth
+sharp-smooth
+smooth-sharp
+sharp-sharp
+smooth-like-vertex
+sharp-like-vertex
+smooth-continue
+sharp-continue ;
+
+: polygon>double-face ( polygon mode -- edge )
+ ! This only handles the simple case with no repeating vertices
+ drop
+ dup all-unique? [ "polygon>double-face doesn't support repeating vertices yet" throw ] unless
+ (polygon>double-face) ;
+
+:: extrude-simple ( edge dist sharp? -- edge )
+ edge face-normal dist v*n :> vec
+ edge vertex-pos vec v+ :> pos
+ edge pos make-ev-one :> e0!
+ e0 opposite-edge>> :> e-end
+ edge face-ccw :> edge!
+
+ [ edge e-end eq? not ] [
+ edge vertex-pos vec v+ :> pos
+ edge pos make-ev-one :> e1
+ e0 e1 make-ef drop
+ e1 e0!
+ edge face-ccw edge!
+ ] do while
+
+ e-end face-ccw :> e-end
+ e0 e-end make-ef drop
+
+ e-end ;
+
+: check-bridge-rings ( e1 e2 -- )
+ {
+ [ [ face>> assert-no-rings ] bi@ ]
+ [ [ face>> assert-base-face ] bi@ ]
+ [ assert-different-faces ]
+ [ [ face-sides ] bi@ assert= ]
+ } 2cleave ;
+
+:: bridge-rings-simple ( e1 e2 sharp? -- edge )
+ e1 e2 check-bridge-rings
+ e1 e2 kill-f-make-rh
+ e1 e2 make-e-kill-r face-cw :> ea!
+ e2 face-ccw :> eb!
+ [ ea e1 eq? not ] [
+ ea eb make-ef opposite-edge>> face-cw ea!
+ eb face-ccw eb!
+ ] while
+ eb ;
+
+:: project-pt-line ( p p0 p1 -- q )
+ p1 p0 v- :> vt
+ p p0 v- vt v* sum
+ vt norm-sq /
+ vt n*v p0 v+ ; inline
+
+:: project-pt-plane ( line-p0 line-vt plane-n plane-d -- q )
+ plane-d neg plane-n line-p0 v. -
+ line-vt plane-n v. /
+ line-vt n*v line-p0 v+ ; inline
+
+: project-poly-plane ( poly vdir plane-n plane-d -- qoly )
+ '[ _ _ _ project-pt-plane ] map ; inline
--- /dev/null
+USING: accessors euler.operators euler.modeling euler.b-rep
+kernel tools.test game.models.half-edge combinators namespaces
+fry sequences make ;
+FROM: euler.b-rep => has-rings? ;
+IN: euler.operators.tests
+
+{ t } [ [ ] make-b-rep b-rep? ] unit-test
+
+{ } [
+ [
+ { 1 0 0 }
+ { 0 1 0 }
+ make-vefs
+ {
+ [ face-ccw vertex-pos { 1 0 0 } assert= ]
+ [ vertex-pos { 0 1 0 } assert= ]
+ [ vertex-valence 1 assert= ]
+ [ face-ccw vertex-valence 1 assert= ]
+ [ dup face-ccw assert-same-face ]
+ } cleave
+ ] make-b-rep check-b-rep
+] unit-test
+
+{ } [
+ [
+ { 1 0 0 }
+ { 0 1 0 }
+ make-vefs
+ kill-vefs
+ ] make-b-rep assert-empty-b-rep
+] unit-test
+
+[
+ [
+ { 1 0 0 }
+ { 0 1 0 }
+ make-vefs
+ dup face-ccw
+ { 0 0 1 } make-ev
+ ] make-b-rep
+] [ edges-not-incident? ] must-fail-with
+
+{ } [
+ [
+ 0
+ 1
+ make-vefs
+ dup 2 make-ev
+ [ vertex-pos 2 assert= ]
+ [ opposite-edge>> vertex-pos 1 assert= ]
+ bi
+ ] make-b-rep check-b-rep
+] unit-test
+
+{ } [
+ [
+ { 1 0 0 }
+ { 0 1 0 }
+ make-vefs
+ dup dup { 0 0 1 } make-ev kill-ev
+ kill-vefs
+ ] make-b-rep assert-empty-b-rep
+] unit-test
+
+{ } [
+ [
+ { 1 2 3 } smooth-smooth polygon>double-face
+ dup face-cw opposite-edge>>
+ 2dup [ "a" set ] [ "b" set ] bi*
+ 4 make-ev {
+ [ face-sides 4 assert= ]
+ [ vertex-pos 4 assert= ]
+ [ opposite-edge>> face-sides 4 assert= ]
+ [ face-ccw "b" get assert= ]
+ [ face-cw "a" get opposite-edge>> assert= ]
+ } cleave
+ ] make-b-rep check-b-rep
+] unit-test
+
+{ } [
+ [
+ { 1 2 3 4 } smooth-smooth polygon>double-face
+ [ face-ccw opposite-edge>> ]
+ [ face-ccw face-ccw ]
+ [ dup face-ccw face-ccw make-ef drop ] tri
+ 5 make-ev {
+ [ vertex-pos 5 assert= ]
+ [ face-sides 4 assert= ]
+ } cleave
+ ] make-b-rep check-b-rep
+] unit-test
+
+{ } [
+ [
+ { 1 0 0 }
+ { 0 1 0 }
+ make-vefs
+ [
+ dup dup make-ef
+ [ face>> ] bi@ eq? f assert=
+ ]
+ [ vertex-valence 3 assert= ]
+ bi
+ ] make-b-rep check-b-rep
+] unit-test
+
+[
+ [
+ { 1 0 0 }
+ { 0 1 0 }
+ make-vefs
+ dup dup make-ef make-ef
+ ] make-b-rep
+] [ edges-in-different-faces? ] must-fail-with
+
+{ } [
+ [
+ { 1 0 0 }
+ { 0 1 0 }
+ make-vefs
+ dup opposite-edge>>
+ [ [ "a" set ] [ "b" set ] bi* ]
+ [
+ make-ef
+ {
+ [ vertex-valence 2 assert= ]
+ [ opposite-edge>> vertex-valence 2 assert= ]
+ [ next-edge>> "a" get assert= ]
+ [ opposite-edge>> next-edge>> "b" get assert= ]
+ [ dup opposite-edge>> [ face>> ] bi@ eq? f assert= ]
+ } cleave
+ ] 2bi
+ ] make-b-rep check-b-rep
+] unit-test
+
+{ } [
+ [
+ { 1 2 3 4 } smooth-smooth polygon>double-face
+ { 5 6 7 8 } smooth-smooth polygon>double-face
+ { 9 10 11 12 } smooth-smooth polygon>double-face
+ {
+ [ [ drop ] dip kill-f-make-rh ]
+ [ [ drop ] 2dip kill-f-make-rh ]
+ [ [ drop ] dip [ face>> ] bi@ [ base-face>> ] dip assert= ]
+ [ [ drop ] 2dip [ face>> ] bi@ [ base-face>> ] dip assert= ]
+ [ 2nip face>> has-rings? t assert= ]
+ [ drop drop make-f-kill-rh ]
+ [ drop nip make-f-kill-rh ]
+ [ drop drop face>> dup base-face>> assert= ]
+ [ drop nip face>> dup base-face>> assert= ]
+ [ 2nip face>> has-rings? f assert= ]
+ } 3cleave
+ ] make-b-rep check-b-rep
+] unit-test
+
+{
+ { 0 1 0 }
+ { 1 0 0 }
+ { 1 2 1 }
+ { 2 1 1 }
+} [
+ [
+ { 1 0 0 }
+ { 0 1 0 }
+ make-vefs
+ dup opposite-edge>>
+ {
+ [ [ vertex-pos ] bi@ ]
+ [ drop { 1 1 1 } move-e ]
+ [ [ vertex-pos ] bi@ ]
+ } 2cleave
+ ] make-b-rep check-b-rep
+] unit-test
+
+{
+ {
+ { 2 1 1 }
+ { 1 2 1 }
+ { 1 1 2 }
+ }
+} [
+ [
+ { { 1 0 0 } { 0 1 0 } { 0 0 1 } } smooth-smooth polygon>double-face
+ [ { 1 1 1 } move-f ]
+ [ [ [ vertex-pos , ] each-face-edge ] { } make ]
+ bi
+ ] make-b-rep check-b-rep
+] unit-test
+
+! Make sure we update the face's edge when killing an edge
+{ } [
+ [
+ { 1 2 3 4 } smooth-smooth polygon>double-face
+ kill-ev
+ ] make-b-rep check-b-rep
+] unit-test
+
+{ } [
+ [
+ { 1 2 3 4 } smooth-smooth polygon>double-face
+ face-ccw kill-ev
+ ] make-b-rep check-b-rep
+] unit-test
+
+{ } [
+ [
+ { 1 2 3 4 } smooth-smooth polygon>double-face
+ face-ccw face-ccw kill-ev
+ ] make-b-rep check-b-rep
+] unit-test
+
+{ } [
+ [
+ { 1 2 3 4 } smooth-smooth polygon>double-face
+ face-ccw face-ccw face-ccw kill-ev
+ ] make-b-rep check-b-rep
+] unit-test
--- /dev/null
+! Copyright (C) 2010 Slava Pestov.
+USING: accessors combinators fry kernel locals namespaces
+game.models.half-edge euler.b-rep sequences typed math
+math.vectors ;
+IN: euler.operators
+
+ERROR: edges-not-incident ;
+
+: assert-incident ( e1 e2 -- )
+ incident? [ edges-not-incident ] unless ;
+
+ERROR: should-not-be-equal obj1 obj2 ;
+
+: assert-not= ( obj1 obj2 -- )
+ 2dup eq? [ should-not-be-equal ] [ 2drop ] if ;
+
+ERROR: edges-in-different-faces ;
+
+: assert-same-face ( e1 e2 -- )
+ same-face? [ edges-in-different-faces ] unless ;
+
+ERROR: edges-in-same-face ;
+
+: assert-different-faces ( e1 e2 -- )
+ same-face? [ edges-in-same-face ] when ;
+
+: assert-isolated-component ( edge -- )
+ [ [ opposite-edge>> ] [ next-edge>> ] bi assert= ]
+ [ dup opposite-edge>> assert-same-face ]
+ bi ;
+
+ERROR: not-a-base-face face ;
+
+: assert-base-face ( face -- )
+ dup base-face? [ drop ] [ not-a-base-face ] if ;
+
+ERROR: has-rings face ;
+
+: assert-no-rings ( face -- )
+ dup next-ring>> [ has-rings ] [ drop ] if ;
+
+: assert-ring-of ( ring face -- )
+ [ base-face>> ] dip assert= ;
+
+: with-b-rep ( b-rep quot -- )
+ [ b-rep ] dip with-variable ; inline
+
+: make-b-rep ( quot -- b-rep )
+ <b-rep> [ swap with-b-rep ] [ finish-b-rep ] [ ] tri ; inline
+
+<PRIVATE
+
+:: make-loop ( vertex face -- edge )
+ b-rep get new-edge :> edge
+ vertex edge vertex<<
+ edge edge next-edge<<
+ face edge face<<
+
+ edge ;
+
+: make-loop-face ( vertex -- edge )
+ b-rep get new-face
+ dup >>base-face
+ make-loop ;
+
+:: make-edge ( vertex next-edge -- edge )
+ b-rep get new-edge :> edge
+ vertex edge vertex<<
+ next-edge edge next-edge<<
+ next-edge face>> edge face<<
+
+ edge ;
+
+: opposite-edges ( e1 e2 -- )
+ [ opposite-edge<< ] [ swap opposite-edge<< ] 2bi ;
+
+PRIVATE>
+
+MIXIN: point
+INSTANCE: sequence point
+INSTANCE: number point
+
+TYPED:: make-vefs ( pos1: point pos2: point -- edge: b-edge )
+ b-rep get :> b-rep
+
+ pos1 b-rep new-vertex :> v1
+ v1 make-loop-face :> e1
+
+ pos2 b-rep new-vertex :> v2
+ v2 e1 make-edge :> e2
+
+ e2 e1 next-edge<<
+ e1 e2 opposite-edges
+
+ e2 ;
+
+TYPED:: make-ev-one ( edge: b-edge point: point -- edge: b-edge )
+ point b-rep get new-vertex :> v
+ v edge make-edge :> e1'
+
+ edge vertex>> e1' make-edge :> e2'
+
+ e2' edge face-cw next-edge<<
+ e1' e2' opposite-edges
+
+ e1' ;
+
+<PRIVATE
+
+:: subdivide-vertex-cycle ( e1 e2 v -- )
+ e1 e2 eq? [
+ v e1 vertex<<
+ e1 vertex-cw e2 v subdivide-vertex-cycle
+ ] unless ;
+
+:: (make-ev) ( e1 e2 point -- edge )
+ e1 e2 assert-incident
+
+ point b-rep get new-vertex :> v'
+ v' e2 make-edge :> e1'
+
+ e1 vertex>> :> v
+
+ v e1 make-edge :> e2'
+
+ e1 e2 v' subdivide-vertex-cycle
+
+ e1 face-cw :> e1p
+ e2 face-cw :> e2p
+ e1 opposite-edge>> :> e1m
+
+ e1m e1p assert-not=
+
+ e1' e2p next-edge<<
+ e2' e1p next-edge<<
+
+ e1' e2' opposite-edges
+
+ e1' ;
+
+PRIVATE>
+
+TYPED:: make-ev ( e1: b-edge e2: b-edge point: point -- edge: b-edge )
+ e1 e2 eq?
+ [ e1 point make-ev-one ] [ e1 e2 point (make-ev) ] if ;
+
+<PRIVATE
+
+: subdivide-edge-cycle ( face e1 e2 -- )
+ 2dup eq? [ 3drop ] [
+ [ drop face<< ]
+ [ [ next-edge>> ] dip subdivide-edge-cycle ] 3bi
+ ] if ;
+
+PRIVATE>
+
+TYPED:: make-ef ( e1: b-edge e2: b-edge -- edge: b-edge )
+ e1 e2 assert-same-face
+
+ e2 vertex>> make-loop-face :> e1'
+ e1 vertex>> e2 make-edge :> e2'
+ e1' e2' opposite-edges
+
+ e1 face-cw :> e1p
+
+ e1 e2 eq? [
+ e2 face-cw :> e2p
+
+ e1' face>> e1 e2 subdivide-edge-cycle
+
+ e1' e2p next-edge<<
+ e1 e1' next-edge<<
+ ] unless
+
+ e2' e1p next-edge<<
+ e1' ;
+
+TYPED:: make-e-kill-r ( edge-ring: b-edge edge-face: b-edge -- edge: b-edge )
+ edge-ring face>> :> ring
+ edge-face face>> :> face
+ ring face assert-ring-of
+
+ edge-ring [ face >>face drop ] each-face-edge
+
+ edge-ring vertex>> edge-face make-edge :> e1
+ edge-face vertex>> edge-ring make-edge :> e2
+
+ ring face delete-ring
+ ring b-rep get delete-face
+
+ e2 edge-face face-cw next-edge<<
+ e1 edge-ring face-cw next-edge<<
+
+ e1 e2 opposite-edges
+
+ e1 ;
+
+TYPED:: make-f-kill-rh ( edge-ring: b-edge -- )
+ edge-ring face>> :> ring
+ ring base-face>> :> base-face
+ ring base-face delete-ring
+ ring ring base-face<< ;
+
+TYPED:: kill-vefs ( edge: b-edge -- )
+ edge assert-isolated-component
+
+ b-rep get :> b-rep
+ edge dup opposite-edge>> :> ( e2 e1 )
+
+ e1 vertex>> :> v1
+ e2 vertex>> :> v2
+
+ e1 face>> b-rep delete-face
+
+ e1 b-rep delete-edge
+ e2 b-rep delete-edge
+ v1 b-rep delete-vertex
+ v2 b-rep delete-vertex ;
+
+TYPED:: kill-ev ( edge: b-edge -- )
+ b-rep get :> b-rep
+
+ edge vertex>> :> v
+ edge opposite-edge>> :> edge'
+ edge' vertex>> :> v'
+
+ edge [ v' >>vertex drop ] each-vertex-edge
+
+ edge face-cw :> edgep
+ edge' face-cw :> edge'p
+
+ edge next-edge>> edgep next-edge<<
+ edge' next-edge>> edge'p next-edge<<
+
+ v b-rep delete-vertex
+ edge b-rep delete-edge
+ edge' b-rep delete-edge ;
+
+TYPED:: kill-ef ( edge: b-edge -- )
+ b-rep get :> b-rep
+
+ edge :> e1
+ edge opposite-edge>> :> e2
+
+ e1 e2 assert-different-faces
+
+ e1 face-cw :> e1p
+ e2 face-cw :> e2p
+
+ e1 face>> :> f1
+ e2 face>> :> f2
+
+ e1 [ f2 >>face drop ] each-face-edge
+ f1 b-rep delete-face
+
+ e1 e2 incident? [
+ e2 next-edge>> e2p next-edge<<
+
+ ] [
+ e2 next-edge>> e1p next-edge<<
+ e1 next-edge>> e2p next-edge<<
+ ] if
+
+ e1 b-rep delete-edge
+ e2 b-rep delete-edge ;
+
+TYPED:: kill-e-make-r ( edge: b-edge -- edge-ring: b-edge )
+ b-rep get :> b-rep
+
+ edge opposite-edge>> :> edge'
+ edge' next-edge>> :> edge-ring
+ edge-ring opposite-edge>> :> edge-ring'
+
+ edge edge' assert-same-face
+ edge edge-ring assert-same-face
+ edge edge-ring' assert-different-faces
+
+ b-rep new-face :> ring
+
+ ring edge face>> base-face>> add-ring
+ ring edge' edge subdivide-edge-cycle
+
+ edge b-rep delete-edge
+ edge' b-rep delete-edge
+
+ edge-ring ;
+
+TYPED:: kill-f-make-rh ( edge-face: b-edge edge-base-face: b-edge -- )
+ edge-face face>> :> face
+ edge-base-face face>> :> base-face
+
+ face assert-base-face
+ base-face assert-base-face
+ edge-face edge-base-face assert-different-faces
+
+ face base-face add-ring ;
+
+TYPED: move-v ( edge: b-edge point: point -- )
+ swap vertex>> position<< ;
+
+TYPED: move-e ( edge: b-edge offset: point -- )
+ [ dup opposite-edge>> ] dip
+ '[ vertex>> [ _ v+ ] change-position drop ] bi@ ;
+
+TYPED: move-f ( edge: b-edge offset: point -- )
+ '[ vertex>> [ _ v+ ] change-position drop ] each-face-edge ;
+
+TYPED: sharp-e ( edge: b-edge sharp?: boolean -- )
+ >>sharpness drop ;
+
+TYPED: sharp-f ( edge: b-edge sharp?: boolean -- )
+ '[ _ sharp-e ] each-face-edge ;
+
+TYPED: sharp-v ( edge: b-edge sharp?: boolean -- )
+ '[ _ sharp-e ] each-vertex-edge ;
+
+TYPED: material-f ( edge: b-edge material -- ) 2drop ;
projects / factor.git / commitdiff