extra/euler/b-rep/io/obj/obj.factor

   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 ;
   5 IN: euler.b-rep.io.obj
   6
   7 <PRIVATE
   8 : write-obj-vertex ( vertex -- )
   9     "v " write
  10     position>> 3 head-slice [ bl ] [ number>string write ] interleave nl ;
  11
  12 : write-obj-face ( face vx-indices -- )
  13     "f" write
  14     [ edge>> ] dip '[ bl vertex>> _ at 1 + number>string write ] each-face-edge nl ;
  15 PRIVATE>
  16
  17 :: write-obj ( b-rep -- )
  18     b-rep vertices>> :> vertices
  19     vertices >index-hash :> vx-indices
  20
  21     vertices [ write-obj-vertex ] each
  22     b-rep faces>> [ vx-indices write-obj-face ] each ;
  23
  24 <PRIVATE
  25 :: reconstruct-face ( face-vertices vertices -- face edges )
  26     face new
  27         dup >>base-face
  28         :> face
  29     face-vertices [
  30         vertices nth :> vertex
  31         b-edge new
  32             vertex >>vertex
  33             face >>face
  34             :> edge
  35         vertex [ [ edge ] unless* ] change-edge drop
  36         edge
  37     ] { } map-as :> edges
  38
  39     edges 1 edges length 1 + edges <circular-slice> [ >>next-edge drop ] 2each
  40     face edges first >>edge
  41     edges ;
  42
  43 :: reconstruct-b-rep ( vertex-positions faces-vertices -- b-rep )
  44     vertex-positions [ vertex new swap >>position ] { } map-as :> vertices
  45     V{ } clone :> edges
  46     faces-vertices [ vertices reconstruct-face edges push-all ] { } map-as :> faces
  47
  48     b-rep new
  49         faces >>faces
  50         edges >>edges
  51         vertices >>vertices
  52     dup connect-opposite-edges ;
  53
  54 : parse-vertex ( line -- position )
  55     " " split first3 [ string>number >float ] tri@ 0.0 double-4-boa ;
  56
  57 : read-vertex ( line vertices -- )
  58     [ parse-vertex ] dip push ;
  59
  60 : parse-face-index ( token vertices -- index )
  61     swap "/" split1 drop string>number
  62     dup 0 >= [ nip 1 - ] [ [ length ] dip + ] if ;
  63
  64 : parse-face ( line vertices -- vertices )
  65     [ " " split ] dip '[ _ parse-face-index ] map ;
  66
  67 : read-face ( line vertices faces -- )
  68     [ parse-face ] dip push ;
  69
  70 PRIVATE>
  71
  72 :: (read-obj) ( -- vertices faces )
  73     V{ } clone :> vertices
  74     V{ } clone :> faces
  75     [
  76         " " split1 swap {
  77             { "#" [ drop ] }
  78             { "v" [ vertices read-vertex ] }
  79             { "f" [ vertices faces read-face ] }
  80             [ 2drop ]
  81         } case
  82     ] each-line
  83     vertices faces ;
  84
  85 :: read-obj ( -- b-rep )
  86     (read-obj) reconstruct-b-rep ;