extra/game/models/obj/obj.factor

   1 ! Copyright (C) 2010 Erik Charlebois
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: io io.encodings.ascii math.parser sequences splitting
   4 kernel assocs io.files combinators math.order math namespaces
   5 arrays sequences.deep accessors alien.c-types alien.data
   6 game.models game.models.util gpu.shaders images game.models.loader
   7 prettyprint specialized-arrays make ;
   8 QUALIFIED-WITH: alien.c-types c
   9 SPECIALIZED-ARRAYS: c:float c:uint ;
  10 IN: game.models.obj
  11
  12 SINGLETON: obj-models
  13 "obj" ascii obj-models register-models-class
  14
  15 <PRIVATE
  16 SYMBOLS: vp vt vn current-model current-material material-dictionary models ;
  17
  18 TUPLE: material
  19     { name                     initial: f }
  20     { ambient-reflectivity     initial: { 1.0 1.0 1.0 } }
  21     { diffuse-reflectivity     initial: { 1.0 1.0 1.0 } }
  22     { specular-reflectivity    initial: { 1.0 1.0 1.0 } }
  23     { transmission-filter      initial: { 1.0 1.0 1.0 } }
  24     { dissolve                 initial: 1.0 }
  25     { specular-exponent        initial: 10.0 }
  26     { refraction-index         initial: 1.5 }
  27     { ambient-map              initial: f }
  28     { diffuse-map              initial: f }
  29     { specular-map             initial: f }
  30     { specular-exponent-map    initial: f }
  31     { dissolve-map             initial: f }
  32     { displacement-map         initial: f }
  33     { bump-map                 initial: f }
  34     { reflection-map           initial: f } ;
  35
  36 : cm ( -- current-material ) current-material get ; inline
  37 : md ( -- material-dictionary ) material-dictionary get ; inline
  38
  39 : strings>numbers ( strings -- numbers )
  40     [ string>number ] map ;
  41
  42 : strings>faces ( strings -- faces )
  43     [ "/" split [ string>number ] map ] map ;
  44
  45 : split-string ( string -- strings )
  46     " \t\n" split harvest ;
  47
  48 : line>mtl ( line -- )
  49     " \t\n" split harvest [
  50         unclip {
  51             { "newmtl" [ first
  52                 [ material new swap >>name current-material set ]
  53                 [ cm swap md set-at ] bi
  54             ] }
  55             { "Ka"       [ 3 head strings>numbers cm ambient-reflectivity<<  ] }
  56             { "Kd"       [ 3 head strings>numbers cm diffuse-reflectivity<<  ] }
  57             { "Ks"       [ 3 head strings>numbers cm specular-reflectivity<< ] }
  58             { "Tf"       [ 3 head strings>numbers cm transmission-filter<<   ] }
  59             { "d"        [ first string>number cm    dissolve<<              ] }
  60             { "Ns"       [ first string>number cm    specular-exponent<<     ] }
  61             { "Ni"       [ first string>number cm    refraction-index<<      ] }
  62             { "map_Ka"   [ first cm                  ambient-map<<           ] }
  63             { "map_Kd"   [ first cm                  diffuse-map<<           ] }
  64             { "map_Ks"   [ first cm                  specular-map<<          ] }
  65             { "map_Ns"   [ first cm                  specular-exponent-map<< ] }
  66             { "map_d"    [ first cm                  dissolve-map<<          ] }
  67             { "map_bump" [ first cm                  bump-map<<              ] }
  68             { "bump"     [ first cm                  bump-map<<              ] }
  69             { "disp"     [ first cm                  displacement-map<<      ] }
  70             { "refl"     [ first cm                  reflection-map<<        ] }
  71             [ 2drop ]
  72         } case
  73     ] unless-empty ;
  74
  75 : read-mtl ( file -- material-dictionary )
  76     [
  77         f current-material ,,
  78         H{ } clone material-dictionary ,,
  79     ] H{ } make
  80     [
  81         ascii file-lines [ line>mtl ] each
  82         md
  83     ] with-variables ;
  84
  85 VERTEX-FORMAT: obj-vertex-format
  86     { "POSITION" float-components 3 f }
  87     { "TEXCOORD" float-components 2 f }
  88     { "NORMAL"   float-components 3 f } ;
  89
  90 : triangle>aos ( x -- y )
  91     dup length {
  92         { 3 [
  93             first3
  94             [ 1 - vp get nth ]
  95             [ 1 - vt get nth ]
  96             [ 1 - vn get nth ] tri* 3array flatten
  97         ] }
  98         { 2 [
  99             first2
 100             [ 1 - vp get nth ]
 101             [ 1 - vt get nth ] bi* 2array flatten
 102         ] }
 103     } case ;
 104
 105 : quad>aos ( x -- y z )
 106     [ 3 head [ triangle>aos 1array ] map ]
 107     [
 108         [ 2 swap nth ]
 109         [ 3 swap nth ]
 110         [ 0 swap nth ] tri 3array
 111         [ triangle>aos 1array ] map
 112     ] bi ;
 113
 114 : face>aos ( x -- y )
 115     dup length {
 116         { 3 [ [ triangle>aos 1array ] map 1array ] }
 117         { 4 [ quad>aos 2array ] }
 118     } case ;
 119
 120 : push* ( elt seq -- seq )
 121     [ push ] keep ;
 122
 123 : push-current-model ( -- )
 124     current-model get [
 125         [ dseq>> flatten c:float >c-array ]
 126         [ iseq>> flatten c:uint >c-array ]
 127         bi obj-vertex-format current-material get model boa models get push
 128         V{ } V{ } H{ } <indexed-seq> current-model set
 129     ] unless-empty ;
 130
 131 : line>obj ( line -- )
 132     split-string [
 133         unclip {
 134             { "mtllib" [ first read-mtl material-dictionary set ] }
 135             { "v"      [ strings>numbers 3 head vp [ push* ] change ] }
 136             { "vt"     [ strings>numbers 2 head vt [ push* ] change ] }
 137             { "vn"     [ strings>numbers 3 head vn [ push* ] change ] }
 138             { "usemtl" [ push-current-model first md at current-material set ] }
 139             { "f"      [ strings>faces face>aos [ [ current-model [ push* ] change ] each ] each ] }
 140             [ 2drop ]
 141         } case
 142     ] unless-empty ;
 143
 144 PRIVATE>
 145
 146 M: obj-models stream>models
 147     drop
 148     [
 149         V{ } clone vp ,,
 150         V{ } clone vt ,,
 151         V{ } clone vn ,,
 152         V{ } clone models ,,
 153         V{ } V{ } H{ } <indexed-seq> current-model ,,
 154         f current-material ,,
 155         f material-dictionary ,,
 156     ] H{ } make
 157     [
 158         [ line>obj ] each-stream-line push-current-model
 159         models get
 160     ] with-variables ;