1 ! Copyright (C) 2010 Joe Groff.
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs combinators euler.b-rep fry
4 game.models.half-edge grouping io kernel locals math
5 math.parser math.vectors.simd.cords sequences splitting ;
9 : write-obj-vertex ( vertex -- )
11 position>> 3 head-slice [ bl ] [ number>string write ] interleave nl ;
13 : write-obj-face ( face vx-indices -- )
15 [ edge>> ] dip '[ bl vertex>> _ at 1 + number>string write ] each-face-edge nl ;
18 :: write-obj ( b-rep -- )
19 b-rep vertices>> :> vertices
20 vertices >index-hash :> vx-indices
22 vertices [ write-obj-vertex ] each
23 b-rep faces>> [ vx-indices write-obj-face ] each ;
26 :: reconstruct-face ( face-vertices vertices -- face edges )
31 vertices nth :> vertex
36 vertex [ [ edge ] unless* ] change-edge drop
40 edges 1 edges length 1 + edges <circular-slice> [ >>next-edge drop ] 2each
41 face edges first >>edge
44 :: reconstruct-b-rep ( vertex-positions faces-vertices -- b-rep )
45 vertex-positions [ vertex new swap >>position ] { } map-as :> vertices
47 faces-vertices [ vertices reconstruct-face edges push-all ] { } map-as :> faces
53 dup connect-opposite-edges ;
55 : parse-vertex ( line -- position )
56 split-words first3 [ string>number >float ] tri@ 0.0 double-4-boa ;
58 : read-vertex ( line vertices -- )
59 [ parse-vertex ] dip push ;
61 : parse-face-index ( token vertices -- index )
62 swap "/" split1 drop string>number
63 dup 0 >= [ nip 1 - ] [ [ length ] dip + ] if ;
65 : parse-face ( line vertices -- vertices )
66 [ split-words ] dip '[ _ parse-face-index ] map ;
68 : read-face ( line vertices faces -- )
69 [ parse-face ] dip push ;
73 :: (read-obj) ( -- vertices faces )
74 V{ } clone :> vertices
79 { "v" [ vertices read-vertex ] }
80 { "f" [ vertices faces read-face ] }
86 :: read-obj ( -- b-rep )
87 (read-obj) reconstruct-b-rep ;