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

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