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 ;
13 "obj" ascii obj-models register-models-class
16 SYMBOLS: vp vt vn current-model current-material material-dictionary models ;
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 } ;
36 : cm ( -- current-material ) current-material get ; inline
37 : md ( -- material-dictionary ) material-dictionary get ; inline
39 : strings>numbers ( strings -- numbers )
40 [ string>number ] map ;
42 : strings>faces ( strings -- faces )
43 [ "/" split [ string>number ] map ] map ;
45 : split-string ( string -- strings )
46 " \t\n" split harvest ;
48 : line>mtl ( line -- )
49 " \t\n" split harvest [
52 [ material new swap >>name current-material set ]
53 [ cm swap md set-at ] bi
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<< ] }
75 : read-mtl ( file -- material-dictionary )
78 H{ } clone material-dictionary ,,
81 ascii file-lines [ line>mtl ] each
85 VERTEX-FORMAT: obj-vertex-format
86 { "POSITION" float-components 3 f }
87 { "TEXCOORD" float-components 2 f }
88 { "NORMAL" float-components 3 f } ;
90 : triangle>aos ( x -- y )
96 [ 1 - vn get nth ] tri* 3array flatten
101 [ 1 - vt get nth ] bi* 2array flatten
105 : quad>aos ( x -- y z )
106 [ 3 head [ triangle>aos 1array ] map ]
110 [ 0 swap nth ] tri 3array
111 [ triangle>aos 1array ] map
114 : face>aos ( x -- y )
116 { 3 [ [ triangle>aos 1array ] map 1array ] }
117 { 4 [ quad>aos 2array ] }
120 : push* ( elt seq -- seq )
123 : push-current-model ( -- )
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
131 : line>obj ( line -- )
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 ] }
146 M: obj-models stream>models
153 V{ } V{ } H{ } <indexed-seq> current-model ,,
154 f current-material ,,
155 f material-dictionary ,,
158 [ line>obj ] each-stream-line push-current-model