87 lines
2.4 KiB
Factor
87 lines
2.4 KiB
Factor
! (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 ;
|