1 ! (c) 2010 Joe Groff bsd license
2 USING: accessors assocs combinators euler.b-rep fry
3 game.models.half-edge grouping io kernel locals math
4 math.parser math.vectors.simd.cords sequences splitting ;
8 : write-obj-vertex ( vertex -- )
10 position>> 3 head-slice [ bl ] [ number>string write ] interleave nl ;
12 : write-obj-face ( face vx-indices -- )
14 [ edge>> ] dip '[ bl vertex>> _ at 1 + number>string write ] each-face-edge nl ;
17 :: write-obj ( b-rep -- )
18 b-rep vertices>> :> vertices
19 vertices >index-hash :> vx-indices
21 vertices [ write-obj-vertex ] each
22 b-rep faces>> [ vx-indices write-obj-face ] each ;
25 :: reconstruct-face ( face-vertices vertices -- face edges )
30 vertices nth :> vertex
35 vertex [ [ edge ] unless* ] change-edge drop
39 edges 1 edges length 1 + edges <circular-slice> [ >>next-edge drop ] 2each
40 face edges first >>edge
43 :: reconstruct-b-rep ( vertex-positions faces-vertices -- b-rep )
44 vertex-positions [ vertex new swap >>position ] { } map-as :> vertices
46 faces-vertices [ vertices reconstruct-face edges push-all ] { } map-as :> faces
52 dup connect-opposite-edges ;
54 : parse-vertex ( line -- position )
55 " " split first3 [ string>number >float ] tri@ 0.0 double-4-boa ;
57 : read-vertex ( line vertices -- )
58 [ parse-vertex ] dip push ;
60 : parse-face-index ( token vertices -- index )
61 swap "/" split1 drop string>number
62 dup 0 >= [ nip 1 - ] [ [ length ] dip + ] if ;
64 : parse-face ( line vertices -- vertices )
65 [ " " split ] dip '[ _ parse-face-index ] map ;
67 : read-face ( line vertices faces -- )
68 [ parse-face ] dip push ;
72 :: (read-obj) ( -- vertices faces )
73 V{ } clone :> vertices
78 { "v" [ vertices read-vertex ] }
79 { "f" [ vertices faces read-face ] }
85 :: read-obj ( -- b-rep )
86 (read-obj) reconstruct-b-rep ;