1%%
2%%  e3d_bzw.erl --
3%%
4%%     Functions for reading and writing BZFlag World Files (.bzw).
5%%
6%%  Copyright (c) 2006-2011 Dave Rodgers  (aka: trepan)
7%%
8%%  See the file "license.terms" for information on usage and redistribution
9%%  of this file, and for a DISCLAIMER OF ALL WARRANTIES.
10%%
11%%     $Id: e3d_bzw.erl,v 1.44 2005/03/04 09:03:57 dgud Exp $
12%%
13
14-module(e3d_bzw).
15-export([import/1,export/2,export/3]).
16
17-include("e3d.hrl").
18-include("e3d_image.hrl").
19
20-import(lists, [reverse/1,reverse/2,sort/1,keysearch/3,foreach/2,
21		map/2,foldl/3]).
22
23-record(ost,
24	{v=[],					%Vertices.
25	 vt=[],					%Texture vertices.
26	 vn=[],					%Vertex normals.
27	 f=[],					%Faces.
28	 g=[],					%Groups.
29	 mat=[],				%Current material.
30	 matdef=[],				%Material definitions.
31	 dir,					%Directory of .bzw file.
32	 seen=gb_sets:empty()}).		%Unknown type seen.
33
34import(Name) ->
35    case read_open(Name) of
36	{ok,Fd} ->
37	    Dir = filename:dirname(Name),
38	    try import_1(Fd, Dir) of
39		#e3d_file{}=E3dFile ->
40		    {ok,E3dFile#e3d_file{dir=Dir}}
41	    catch
42		throw:Error -> Error
43	    after
44		close(Fd)
45	    end;
46	{error,Reason} ->
47	    {error,file:format_error(Reason)}
48    end.
49
50import_1(Fd, Dir) ->
51    Ost0 = read(fun parse/2, Fd, #ost{dir=Dir}),
52    Ost = remember_eof(Ost0),
53    #ost{v=Vtab0,vt=TxTab0,f=Ftab0,g=Gs0,vn=VnTab0,matdef=Mat} = Ost,
54    Vtab = reverse(Vtab0),
55    TxTab = reverse(TxTab0),
56    VnTab = reverse(VnTab0),
57    Ftab = make_ftab(Ftab0, []),
58    Gs1 = reverse(Gs0),
59    Gs = separate(Gs1, []),
60    Template = #e3d_mesh{type=polygon,vs=Vtab,tx=TxTab,ns=VnTab},
61    Objs = make_objects(Gs, Ftab, Template),
62    #e3d_file{objs=Objs,mat=Mat}.
63
64separate([{eof,N}], []) -> [{undefined,N}];
65separate([{eof,_}], [{_,_,E}|_]=Acc) ->
66    separate_1(Acc, E, []);
67separate([{group,[Name|_],N}|T], Acc) ->
68    separate(T, [{Name,N,get_face_num(T)}|Acc]);
69separate([{name,Name,Start}|T0], Acc) ->
70    {T,End} = skip_upto_name(T0),
71    separate(T, [{Name,Start,End}|Acc]).
72
73separate_1([{Name,S,E}|T], E, Acc) ->
74    separate_1(T, S, [{Name,E-S}|Acc]);
75separate_1([], _, Acc) -> Acc.
76
77get_face_num([{eof,N}|_]) -> N;
78get_face_num([{group,_,N}|_]) -> N.
79
80skip_upto_name([{eof,N}]=T) -> {T,N};
81skip_upto_name([{name,_,N}|_]=T) -> {T,N};
82skip_upto_name([_|T]) -> skip_upto_name(T).
83
84make_objects([{Name,N}|T], Fs0, Template) ->
85    {Ftab,Fs} = split(Fs0, N, []),
86    Mesh = e3d_mesh:renumber(Template#e3d_mesh{fs=Ftab}),
87    Obj = #e3d_object{name=Name,obj=Mesh},
88    [Obj|make_objects(T, Fs, Template)];
89make_objects([], [], _) -> [].
90
91split(Fs, 0, Acc) -> {reverse(Acc),Fs};
92split([F|Fs], N, Acc) -> split(Fs, N-1, [F|Acc]).
93
94make_ftab([{Mat,Vs0}|Fs], Acc) ->
95    Vs = [V || {V,_,_} <- Vs0],
96    Tx = case [Vt || {_,Vt,_} <- Vs0] of
97	     [none|_] -> [];
98	     Tx0 -> Tx0
99	 end,
100    Ns = case [Vn || {_,_,Vn} <- Vs0] of
101	     [none|_] -> [];
102	     Ns0 -> Ns0
103	 end,
104    make_ftab(Fs, [#e3d_face{mat=Mat,vs=Vs,tx=Tx,ns=Ns}|Acc]);
105make_ftab([], Acc) -> Acc.
106
107read(Parse, Fd0, Acc) ->
108    {Line,Fd} = get_line(Fd0),
109    read_1(Parse, Line, Fd, Acc).
110
111read_1(_, eof, _, Acc) -> Acc;
112read_1(Parse, [], Fd, Acc) ->
113    %% Blank line - ignore and read the next line.
114    read(Parse, Fd, Acc);
115read_1(Parse, "#" ++ _Comment, Fd, Acc) ->
116    %% Comment - ignore and read the next line.
117    read(Parse, Fd, Acc);
118read_1(Parse, [Ctrl|Line], Fd, Acc) when Ctrl =< $\s ->
119    %% Ignore any leading whitespace (especially TAB and spaces,
120    %% but also control characters such as ^@ which ZBrush 2
121    %% emits at the end of a file).
122    read_1(Parse, Line, Fd, Acc);
123read_1(Parse, "mtllib" ++ Name0, Fd, Acc0) ->
124    Name = skip_blanks(Name0),
125    case Parse(["mtllib",Name], Acc0) of
126	eof -> Acc0;
127	Acc -> read(Parse, Fd, Acc)
128    end;
129read_1(Parse, Line, Fd, Acc0) ->
130    Tokens = collect(Line, [], []),
131    case Parse(Tokens, Acc0) of
132	eof -> Acc0;
133	Acc -> read(Parse, Fd, Acc)
134    end.
135
136collect([$\s|T], [], Tokens) ->
137    collect(T, [], Tokens);
138collect([$\s|T], Curr, Tokens) ->
139    collect(T, [], [reverse(Curr)|Tokens]);
140collect([H|T], Curr, Tokens) ->
141    collect(T, [H|Curr], Tokens);
142collect([], [], Tokens) ->
143    reverse(Tokens);
144collect([], Curr, Tokens) ->
145    collect([], [], [reverse(Curr)|Tokens]).
146
147parse(["  vertex",X0,Y0,Z0|_], #ost{v=Vtab}=Ost) ->
148    X = str2float(X0),
149    Y = str2float(Y0),
150    Z = str2float(Z0),
151    Ost#ost{v=[{X,Y,Z}|Vtab]};
152parse(["  texcoord",U0,V0|_], #ost{vt=Vt}=Ost) ->
153    U = str2float(U0),
154    V = str2float(V0),
155    Ost#ost{vt=[{U,V}|Vt]};
156parse(["  normal",X0,Y0,Z0|_], #ost{vn=Vn}=Ost) ->
157    X = str2float(X0),
158    Y = str2float(Y0),
159    Z = str2float(Z0),
160    Ost#ost{vn=[{X,Y,Z}|Vn]};
161parse(["face"|Vlist0], #ost{f=Ftab,mat=Mat}=Ost) ->
162    Vlist = collect_vs(Vlist0, Ost),
163    Ost#ost{f=[{Mat,Vlist}|Ftab]};
164parse(["name"], Ost) ->Ost;
165parse(["name"|Names], Ost) ->
166    remember_group(Names, Ost);
167parse(["o"], Ost) -> Ost;
168parse(["o",Name|_], Ost) ->
169    remember_name(Name, Ost);
170parse(["usemtl"|[Mat|_]], Ost) ->
171    Ost#ost{mat=[list_to_atom(Mat)]};
172parse(["mtllib",FileName], #ost{dir=Dir}=Ost) ->
173    Mat = read_matlib(FileName, Dir),
174    Ost#ost{matdef=Mat};
175parse(["End","Of","File"], _Ost) ->
176    %% In files written by ZBrush 1.x.
177    eof;
178parse([Tag|_]=Other, #ost{seen=Seen}=Ost) ->
179    case gb_sets:is_member(Tag, Seen) of
180	true -> Ost;
181	false ->
182	    io:format("Ignoring: ~p\n", [Other]),
183	    Ost#ost{seen=gb_sets:insert(Tag, Seen)}
184    end.
185
186remember_eof(#ost{f=Ftab,g=Gs}=Ost) ->
187    Ost#ost{g=[{eof,length(Ftab)}|Gs]}.
188
189remember_group(Names, #ost{g=[{group,Names,_}|_]}=Ost) -> Ost;
190remember_group(Names, #ost{f=Ftab,g=Gs}=Ost) ->
191    Ost#ost{g=[{group,Names,length(Ftab)}|Gs]}.
192
193remember_name(Name, #ost{f=Ftab,g=Gs}=Ost) ->
194    Ost#ost{g=[{name,Name,length(Ftab)}|Gs]}.
195
196collect_vs([V|Vs], Ost) ->
197    [collect_vtxref(V, Ost)|collect_vs(Vs, Ost)];
198collect_vs([], _Ost) -> [].
199
200collect_vtxref(S, Ost) ->
201    case collect_vtxref_1(S, []) of
202	[V] -> collect_vtxref_2(V, none, none, Ost);
203	[V,Vt] -> collect_vtxref_2(V, Vt, none, Ost);
204	[V,Vt,Vn|_] -> collect_vtxref_2(V, Vt, Vn, Ost)
205    end.
206
207collect_vtxref_1([], Acc) -> reverse(Acc);
208collect_vtxref_1(S0, Acc) ->
209    {Ref,S} = collect_one_vtxref(S0),
210    collect_vtxref_1(S, [Ref|Acc]).
211
212collect_vtxref_2(V0, Vt0, Vn0, #ost{v=Vtab,vt=VtTab,vn=VnTab}) ->
213    V = resolve_vtxref(V0, Vtab),
214    Vt = resolve_vtxref(Vt0, VtTab),
215    Vn = resolve_vtxref(Vn0, VnTab),
216    {V,Vt,Vn}.
217
218resolve_vtxref(none, _) -> none;
219resolve_vtxref(V, _) when V > 0 -> V-1;
220resolve_vtxref(V0, Tab) when V0 < 0 ->
221    case length(Tab)+V0 of
222	V when V >= 0 -> V
223    end.
224
225collect_one_vtxref(S) ->
226    collect_one_vtxref(S, []).
227
228collect_one_vtxref([$/|S], Acc) ->
229    collect_one_vtxref_done(S, Acc);
230collect_one_vtxref([H|T], Acc) ->
231    collect_one_vtxref(T, [H|Acc]);
232collect_one_vtxref([], Acc) ->
233    collect_one_vtxref_done([], Acc).
234
235collect_one_vtxref_done(S, []) -> {none,S};
236collect_one_vtxref_done(S, V0) -> {list_to_integer(reverse(V0)),S}.
237
238read_matlib(Name, Dir) ->
239    case try_matlib(filename:join(Dir, Name)) of
240	error ->
241	    case try_matlib(filename:join(Dir, Name)) of
242		error -> [];
243		Other -> Other
244	    end;
245	Res -> Res
246    end.
247
248try_matlib(Name) ->
249    case read_open(Name) of
250	{ok,Fd} ->
251	    Res = read(fun mtl_parse/2, Fd, []),
252	    close(Fd),
253	    [{Mat,[{maps,Maps},{opengl,fixup_mat(OpenGL)}]} ||
254		{Mat,OpenGL,Maps} <- Res];
255	{error,_Reason} -> error
256    end.
257
258%% Combine diffuse color with opacity.
259fixup_mat(OpenGL0) ->
260    Opacity = proplists:get_value(opacity, OpenGL0, 1.0),
261    OpenGL1 = lists:keydelete(opacity, 1, OpenGL0),
262    {R,G,B} = proplists:get_value(diffuse, OpenGL1, {1.0,1.0,1.0}),
263    OpenGL = lists:keydelete(diffuse, 1, OpenGL0),
264    [{diffuse,{R,G,B,Opacity}}|OpenGL].
265
266mtl_parse(["newmtl"|Name0], Ms) ->
267    Name = list_to_atom(space_concat(Name0)),
268    [{Name,[],[]}|Ms];
269mtl_parse(["d",Opacity], Mtl) ->
270    mtl_add({opacity,str2float(Opacity)}, Mtl);
271mtl_parse(["Ka"|RGB], Mtl) ->
272    mtl_add({ambient,mtl_text_to_tuple(RGB)}, Mtl);
273mtl_parse(["Kd"|RGB], Mtl) ->
274    mtl_add({diffuse,mtl_text_to_tuple(RGB)}, Mtl);
275mtl_parse(["Ks"|RGB], Mtl) ->
276    mtl_add({specular,mtl_text_to_tuple(RGB)}, Mtl);
277mtl_parse(["Ke"|RGB], Mtl) ->
278    mtl_add({emission,mtl_text_to_tuple(RGB)}, Mtl);
279mtl_parse(["texture"|Filename0], Mtl) ->
280    Filename = space_concat(Filename0),
281    map_add({diffuse,Filename}, Mtl);
282mtl_parse(["map_Ka"|Filename0], Mtl) ->
283    Filename = space_concat(Filename0),
284    map_add({ambient,Filename}, Mtl);
285mtl_parse(["map_Bump"|Filename0], Mtl) ->
286    Filename = space_concat(Filename0),
287    map_add({bump,Filename}, Mtl);
288mtl_parse([_|_], [{_,_,_}|_]=Mtl) -> Mtl.
289
290mtl_add(P, [{Name,OpenGL,Maps}|Ms]) ->
291    [{Name,[P|OpenGL],Maps}|Ms].
292
293map_add(P, [{Name,OpenGL,Maps}|Ms]) ->
294    [{Name,OpenGL,[P|Maps]}|Ms].
295
296mtl_text_to_tuple(L) ->
297    list_to_tuple([str2float(F) || F <- L]).
298
299str2float("."++_=S) -> str2float_1("0"++S);
300str2float([$-|"."++_=S]) -> str2float_1("-0"++S);
301str2float(S) -> str2float_1(S).
302
303str2float_1(S) ->
304    try
305	list_to_float(S)
306    catch
307	error:badarg ->
308	    str2float_2(S, [])
309    end.
310
311str2float_2([H|T], Acc) when H == $e; H == $E ->
312    foreach(fun($-) -> ok;
313	       ($+) -> ok;
314	       (D) when $0 =< D, D =< $9 -> ok
315	    end, Acc),
316    NumStr = reverse(Acc, ".0e") ++ T,
317    list_to_float(NumStr);
318str2float_2([H|T], Acc) ->
319    str2float_2(T, [H|Acc]);
320str2float_2([], Acc) ->
321    float(list_to_integer(reverse(Acc))).
322
323space_concat([Str|[_|_]=T]) ->
324    Str ++ [$\s|space_concat(T)];
325space_concat([S]) -> S;
326space_concat([]) -> [].
327
328skip_blanks([$\s|T]) -> skip_blanks(T);
329skip_blanks([$\t|T]) -> skip_blanks(T);
330skip_blanks(S) -> S.
331
332read_open(Name) ->
333    case file:open(Name, [read,raw,read_ahead]) of
334	{ok,Fd} -> {ok,{Fd,[]}};
335	{error,_}=Error -> Error
336    end.
337
338close({Fd,_}) ->
339    file:close(Fd).
340
341get_line({Fd,Buf}) ->
342    get_line(Buf, Fd, []).
343
344get_line([], Fd, Line) ->
345    case file:read(Fd, 128) of
346	eof ->
347	    case Line of
348		[] -> {eof,{Fd,[]}};
349		_ -> {reverse(Line),{Fd,[]}}
350	    end;
351	{ok,Cs} -> get_line(Cs, Fd, Line)
352    end;
353get_line([$\r|Cs], Fd, Line) ->
354    {reverse(Line),{Fd,Cs}};
355get_line([$\n|Cs], Fd, Line) ->
356    {reverse(Line),{Fd,Cs}};
357get_line([C|Cs], Fd, Line) ->
358    get_line(Cs, Fd, [C|Line]).
359
360
361
362%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
363%
364%  Export.
365%
366%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
367
368
369export(File, Contents) ->
370    export(File, Contents, []).
371
372
373export(File, #e3d_file{objs=Objs,mat=Mat,creator=Creator}, Flags) ->
374    case file:open(File, [write]) of
375	{error,_}=Error -> Error;
376	{ok,F} ->
377            materials(F, File, Mat, Creator),
378%	    foldl(fun(#e3d_object{name=Name}=Obj, {Vbase,UVbase,Nbase}) ->
379%			  io:put_chars(F, "mesh\r\n"),
380%			  io:format(F, "  name ~s\r\n", [Name]),
381%			  export_object(F, Obj, Flags) end, {1,1,1}, Objs),
382	    foreach(fun(#e3d_object{name=Name}=Obj) ->
383			  io:put_chars(F, "mesh\r\n"),
384			  io:format(F, "  name ~s\r\n", [Name]),
385			  export_object(F, Obj, Flags) end, Objs),
386	    ok = file:close(F)
387    end.
388
389
390export_object(F, #e3d_object{name=Name,obj=Mesh0}, Flags) ->
391    Mesh = case proplists:get_bool(include_normals, Flags) of
392	       false -> Mesh0;
393	       true -> e3d_mesh:vertex_normals(Mesh0)
394	   end,
395    #e3d_mesh{fs=Fs0,vs=Vs,tx=Tx,ns=Ns} = Mesh,
396    mesh_info(F, Mesh),
397	bzw_inside_1(F,Mesh),
398    foreach(fun({X,Y,Z}) ->
399        io:format(F, "  vertex ~s ~s ~s\r\n", [fmtf(X), fmtf(Y), fmtf(Z)])
400    end, Vs),
401    foreach(fun({X,Y,Z}) ->
402        io:format(F, "  normal ~s ~s ~s\r\n", [fmtf(X), fmtf(Y), fmtf(Z)])
403    end, Ns),
404    foreach(fun({U,V}) ->
405        io:format(F, "  texcoord ~s ~s\r\n", [fmtf(U), fmtf(V)])
406    end, Tx),
407    %object_group(F, Name, Flags),
408    object_group(Flags),
409    Fs1 = [{Mat,FaceRec} || #e3d_face{mat=Mat}=FaceRec <- Fs0],
410    Fs = sofs:to_external(sofs:relation_to_family(sofs:relation(Fs1))),
411    foreach(fun(Face) ->
412        face_mat(F, Name, Face, Flags)
413    end, Fs),
414    io:put_chars(F, "end\r\n").
415
416bzw_inside_1(F,#e3d_mesh{vs=Vs}=Mesh) ->
417    case wpa:pref_get(wpc_bzw, bzw_inside) of
418      true ->
419        #e3d_mesh{fs=Fs} = e3d_mesh:triangulate(Mesh),
420        case volume(Fs,Vs,[]) < 1.0E-6 of
421          true ->
422            P = "  #No legal inside point, since volume of object is too small\r\n",
423            io:put_chars(F, P);
424          false ->
425            {Cx,Cy,Cz} = e3d_vec:average(Vs),
426            io:format(F, "  inside ~s ~s ~s\r\n", [fmtf(Cx), fmtf(Cy), fmtf(Cz)])
427        end;
428      false ->
429        ok
430    end.
431
432volume([#e3d_face{vs=[V1,V2,V3]}|Ftab],Vs,Acc) ->
433    Va = lists:nth(V1+1,Vs),
434    Vb = lists:nth(V2+1,Vs),
435    Vc = lists:nth(V3+1,Vs),
436    Bc = e3d_vec:cross(Vb, Vc),
437    volume(Ftab,Vs,[e3d_vec:dot(Va, Bc)/6.0|Acc]);
438
439volume([],_,Acc) ->
440    Volume = lists:sum(Acc),
441    Volume.
442
443%fmtf(F) when abs(F) < 1.0e-40 ->
444%    "0";
445%fmtf(F) when abs(F) < 0.1; abs(F) >= 10000 ->
446%    lists:flatten(io_lib:format("~.4f", [F]));
447fmtf(F) ->
448    lists:flatten(io_lib:format("~.4f", [F])).
449
450%object_group(F, Name, Flags) ->
451object_group(Flags) ->
452    case proplists:get_bool(group_per_material, Flags) of
453	true -> ok;
454	false -> ok
455%	false -> io:format(F, "g ~s\r\n", [Name])
456    end.
457
458face_mat(F, Name, {Ms,Fs}, Flags) ->
459    mat_group(F, Name, Ms, Flags),
460    io:put_chars(F, "  matref"),
461    foldl(fun(M, Prefix) ->
462		  io:format(F, "~c~s", [Prefix,atom_to_list(M)])
463	  end, $\s, Ms),
464    eol(F),
465    foreach(fun(Vs) -> face(F, Vs) end, Fs).
466
467mat_group(F, Name, Ms, Flags) ->
468    case proplists:get_bool(group_per_material, Flags) of
469	true ->
470	    io:format(F, "  #matref ~s # group?", [Name]),
471	    foreach(fun(M) ->
472			    io:format(F, "_~s", [atom_to_list(M)])
473		    end, Ms),
474	    eol(F);
475	false -> ok
476    end.
477
478face(F, #e3d_face{vs=Vs,tx=Tx,ns=Ns}) ->
479    io:put_chars(F, "  face"), eol(F),
480    print_list(F, "vertices",  Vs),
481    print_list(F, "normals",   Ns),
482    print_list(F, "texcoords", Tx),
483%    io:put_chars(F, "    vertices"), face_v(F, Vs), eol(F),
484%    io:put_chars(F, "    normals"), face_n(F, Ns), eol(F),
485%    io:put_chars(F, "    texcoords"), face_t(F, Tx), eol(F),
486    io:put_chars(F, "  endface"), eol(F).
487
488print_list(_, _, []) -> ok;
489print_list(F, ListName, Indices) ->
490  io:format(F, "    ~s", [ListName]),
491  print_indices(F, Indices), eol(F).
492
493print_indices(F, [Index|T]) ->
494  io:put_chars(F, [$\s,integer_to_list(Index)]),
495  print_indices(F, T);
496print_indices(_, []) -> ok.
497
498
499%face_v(F, [V|Vs]) ->
500%    io:put_chars(F, [$\s,integer_to_list(V)]),
501%    face_v(F, Vs);
502%face_v(_, []) -> ok.
503%
504%face_t(F, [T|Ts]) ->
505%    io:put_chars(F, [$\s,integer_to_list(T)]),
506%    face_t(F, Ts);
507%face_t(_, []) -> ok.
508%
509%face_n(F, [N|Ns]) ->
510%    io:put_chars(F, [$\s,integer_to_list(N)]),
511%    face_n(F, Ns);
512%face_n(_, []) -> ok.
513
514
515materials(F, Name0, Mats, Creator) ->
516    Root = filename:rootname(Name0, ".bzw"),
517    Name = Root ++ ".mtl",
518    label(F, Creator),
519    foreach(fun(M) -> material(F, Root, M) end, Mats),
520    {ok,filename:basename(Name)}.
521
522material(F, Root, {Name,Mat}) ->
523    OpenGL = proplists:get_value(opengl, Mat),
524    {_,_,_,Opacity} = proplists:get_value(diffuse, OpenGL),
525    Shininess = proplists:get_value(shininess, OpenGL),
526    io:put_chars(F, "material\r\n"),
527    io:format(F, "  name ~s\r\n", [atom_to_list(Name)]),
528%    mat_color(F, "  ambient", ambient, OpenGL, true),
529    mat_color(F, "  diffuse", diffuse, OpenGL, false),
530    io:format(F, " ~.4f\r\n", [Opacity]),
531    mat_color(F, "  emission", emission, OpenGL, true),
532    mat_color(F, "  specular", specular, OpenGL, true),
533    io:format(F, "  shininess ~.4f\r\n", [Shininess*128]),
534    Maps = proplists:get_value(maps, Mat),
535    export_maps(F, Maps, Root),
536    io:put_chars(F, "end\r\n"),
537    eol(F).
538
539mat_color(F, Label, Key, Mat, EndLine) ->
540    {R,G,B,_} = proplists:get_value(Key, Mat),
541    io:format(F, "~s ~.4f ~.4f ~.4f", [Label,R,G,B]),
542    case EndLine of
543        true -> eol(F);
544        false -> ok
545    end.
546
547export_maps(F, [{diffuse,Map}|T], Base) ->
548    export_map(F, "texture", Map, Base),
549    export_maps(F, T, Base);
550export_maps(F, [{ambient,Map}|T], Base) ->
551    export_map(F, "Ka", Map, Base),
552    export_maps(F, T, Base);
553export_maps(F, [{emission,Map}|T], Base) ->
554    export_map(F, "Ke", Map, Base),
555    export_maps(F, T, Base);
556export_maps(F, [{bump,Map}|T], Base) ->
557    export_map(F, "Bump", Map, Base),
558    export_maps(F, T, Base);
559export_maps(F, [_|T], Base) ->
560    export_maps(F, T, Base);
561export_maps(_, [], _) -> ok.
562
563export_map(_, _, none, _) -> ok;
564export_map(F, Label0, #e3d_image{filename=none,name=ImageName}=Image, Root) ->
565    Label = "  " ++ Label0,
566    MapFile = filename:join(filename:dirname(Root), ImageName ++ ".tga"),
567    io:format(F, "~s ~s\r\n", [Label,filename:basename(MapFile)]),
568    ok = e3d_image:save(Image, MapFile);
569export_map(F, Label0, #e3d_image{filename=Filename}, _Root) ->
570    Label = "  " ++ Label0,
571    io:format(F, "~s ~s\r\n", [Label,filename:basename(Filename)]).
572
573label(F, Creator) ->
574    io:format(F, "# Exported from ~s\r\n\r\n", [Creator]).
575
576mesh_info(F, #e3d_mesh{vs=Vs,fs=Fs}) ->
577    io:format(F, "  #~w vertices, ~w faces\r\n", [length(Vs),length(Fs)]).
578
579eol(F) ->
580    io:put_chars(F, "\r\n").
581