From http://www.jwz.org/xscreensaver/xscreensaver-5.15.tar.gz
[xscreensaver] / hacks / glx / wfront2gl.pl
1 #!/usr/bin/perl -w
2 # Copyright © 2003-2011 Jamie Zawinski <jwz@jwz.org>
3 #
4 # Permission to use, copy, modify, distribute, and sell this software and its
5 # documentation for any purpose is hereby granted without fee, provided that
6 # the above copyright notice appear in all copies and that both that
7 # copyright notice and this permission notice appear in supporting
8 # documentation.  No representations are made about the suitability of this
9 # software for any purpose.  It is provided "as is" without express or 
10 # implied warranty.
11 #
12 # Reads a Wavefront OBJ file, and emits C data suitable for use with OpenGL's
13 # glInterleavedArrays() and glDrawArrays() routines.
14 #
15 # If the OBJ file does not contain face normals, they are computed.
16 # Texture coordinates are ignored.
17 #
18 # Options:
19 #
20 #    --normalize      Compute the bounding box of the object, and scale all
21 #                     coordinates so that the object fits inside a unit cube.
22 #
23 # Created:  8-Mar-2003.
24
25 require 5;
26 use diagnostics;
27 use strict;
28
29 my $progname = $0; $progname =~ s@.*/@@g;
30 my $version = q{ $Revision: 1.4 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
31
32 my $verbose = 0;
33
34
35 # convert a vector to a unit vector
36 sub normalize($$$) {
37   my ($x, $y, $z) = @_;
38   my $L = sqrt (($x * $x) + ($y * $y) + ($z * $z));
39   if ($L != 0) {
40     $x /= $L;
41     $y /= $L;
42     $z /= $L;
43   } else {
44     $x = $y = $z = 0;
45   }
46   return ($x, $y, $z);
47 }
48
49
50 # Calculate the unit normal at p0 given two other points p1,p2 on the
51 # surface.  The normal points in the direction of p1 crossproduct p2.
52 #
53 sub face_normal($$$$$$$$$) {
54   my ($p0x, $p0y, $p0z,
55       $p1x, $p1y, $p1z,
56       $p2x, $p2y, $p2z) = @_;
57
58   my ($nx,  $ny,  $nz);
59   my ($pax, $pay, $paz);
60   my ($pbx, $pby, $pbz);
61
62   $pax = $p1x - $p0x;
63   $pay = $p1y - $p0y;
64   $paz = $p1z - $p0z;
65   $pbx = $p2x - $p0x;
66   $pby = $p2y - $p0y;
67   $pbz = $p2z - $p0z;
68   $nx = $pay * $pbz - $paz * $pby;
69   $ny = $paz * $pbx - $pax * $pbz;
70   $nz = $pax * $pby - $pay * $pbx;
71
72   return (normalize ($nx, $ny, $nz));
73 }
74
75
76 sub parse_obj($$$) {
77   my ($filename, $obj, $normalize_p) = @_;
78
79   $_ = $obj;
80   my @verts = ();    # list of refs of coords, [x, y, z]
81   my @norms = ();    # list of refs of coords, [x, y, z]
82   my @texts = ();    # list of refs of coords, [u, v]
83   my @faces = ();    # list of refs of [ point, point, point, ... ]
84                      #  where 'point' is a ref of indexes into the
85                      #  above lists, [ vert, text, norm ]
86
87   my $lineno = 0;
88   foreach (split (/\n/, $obj)) {
89     $lineno++;
90     next if (m/^\s*$|^\s*\#/);
91
92     if (m/^v\s/) {
93       my ($x, $y, $z) = m/^v\s+([^\s]+)\s+([^\s]+)\s+([^\s]+)\s*$/;
94       error ("line $lineno: unparsable V line: $_") unless defined($z);
95       push @verts, [$x+0, $y+0, $z+0];
96
97     } elsif (m/^vn\s/) {
98       my ($x, $y, $z) = m/^vn\s+([^\s]+)\s+([^\s]+)\s+([^\s]+)\s*$/;
99       error ("line $lineno: unparsable VN line: $_") unless defined($z);
100       push @norms, [$x+0, $y+0, $z+0];
101
102     } elsif (m/^vt\s/) {
103       my ($u, $v) = m/^vt\s+([^\s]+)\s+([^\s]+)\s*$/;
104       error ("line $lineno: unparsable VT line: $_") unless defined($v);
105       push @texts, [$u+0, $v+0];
106
107     } elsif (m/^g\b/) {
108       # group name
109
110     } elsif (m/f\s/) {
111       my @f = split(/\s+/, $_);
112       shift @f;
113       my @vs = ();
114       foreach my $f (@f) {
115         my ($v, $t, $n);
116         if    ($f =~ m@^(\d+)$@s)             { $v = $1; }
117         elsif ($f =~ m@^(\d+)/(\d+)$@s)       { $v = $1, $t = $2; }
118         elsif ($f =~ m@^(\d+)/(\d+)/(\d+)$@s) { $v = $1, $t = $2; $n = $3; }
119         elsif ($f =~ m@^(\d+)///(\d+)$@s)     { $v = $1; $n = $3; }
120         else {
121           error ("line $lineno: unparsable F line: $_") unless defined($v);
122         }
123         $t = -1 unless defined($t);
124         $n = -1 unless defined($n);
125         push @vs, [$v+0, $t+0, $n+0];
126       }
127       push @faces, \@vs;
128
129     } elsif (m/^s\b/) {
130       # turn on smooth shading
131     } elsif (m/^(mtllib|usemtl)\b/) {
132       # reference to external materials file (textures, etc.)
133     } else {
134       error ("line $lineno: unknown line: $_");
135     }
136   }
137
138
139   # find bounding box, and normalize
140   #
141   if ($normalize_p || $verbose) {
142     my $minx =  999999999;
143     my $miny =  999999999;
144     my $minz =  999999999;
145     my $maxx = -999999999;
146     my $maxy = -999999999;
147     my $maxz = -999999999;
148     my $i = 0;
149     foreach my $v (@verts) {
150       my ($x, $y, $z) = @$v;
151       $minx = $x if ($x < $minx);
152       $maxx = $x if ($x > $maxx);
153       $miny = $y if ($y < $miny);
154       $maxy = $y if ($y > $maxy);
155       $minz = $z if ($z < $minz);
156       $maxz = $z if ($z > $maxz);
157     }
158
159     my $w = ($maxx - $minx);
160     my $h = ($maxy - $miny);
161     my $d = ($maxz - $minz);
162     my $sizea = ($w > $h ? $w : $h);
163     my $sizeb = ($w > $d ? $w : $d);
164     my $size = ($sizea > $sizeb ? $sizea : $sizeb);
165         
166     print STDERR "$progname: bbox is " .
167                   sprintf("%.2f x %.2f x %.2f\n", $w, $h, $d)
168        if ($verbose);
169
170     if ($normalize_p) {
171       $w /= $size;
172       $h /= $size;
173       $d /= $size;
174       print STDERR "$progname: dividing by $size for bbox of " .
175                   sprintf("%.2f x %.2f x %.2f\n", $w, $h, $d)
176         if ($verbose);
177       foreach my $n (@verts) {
178         my @n = @$n;
179         foreach (@n) { $_ /= $size; }
180         $n = \@n;
181       }
182     }
183   }
184
185   # generate interleaved list of triangle coordinates and normals
186   #
187   my @triangles = ();
188   my $nfaces = $#faces+1;
189
190   foreach my $f (@faces) {
191     # $f is [ [v, t, n], [v, t, n],  ... ]
192
193     my @f = @$f;
194
195 #    # (Kludge for the companion cube model)
196 #    if ($#f > 15) {
197 #      my $i = 12;
198 #      @f = (@f[$i-1 .. $#f], @f[0 .. $i]);
199 #    }
200
201     error ("too few points in face") if ($#f < 2);
202     my $p1 = shift @f;
203
204     # If there are more than 3 points, do a triangle fan from the first one:
205     # [1 2 3] [1 3 4] [1 4 5] etc.  Doesn't always work with convex shapes.
206
207     while ($#f) {
208       my $p2 = shift @f;
209       my $p3 = $f[0];
210
211       my $x1 = $verts[$p1->[0]-1]->[0]; my $nx1 = $norms[$p1->[2]-1]->[0];
212       my $y1 = $verts[$p1->[0]-1]->[1]; my $ny1 = $norms[$p1->[2]-1]->[1];
213       my $z1 = $verts[$p1->[0]-1]->[2]; my $nz1 = $norms[$p1->[2]-1]->[2];
214
215       my $x2 = $verts[$p2->[0]-1]->[0]; my $nx2 = $norms[$p2->[2]-1]->[0];
216       my $y2 = $verts[$p2->[0]-1]->[1]; my $ny2 = $norms[$p2->[2]-1]->[1];
217       my $z2 = $verts[$p2->[0]-1]->[2]; my $nz2 = $norms[$p2->[2]-1]->[2];
218
219       my $x3 = $verts[$p3->[0]-1]->[0]; my $nx3 = $norms[$p3->[2]-1]->[0];
220       my $y3 = $verts[$p3->[0]-1]->[1]; my $ny3 = $norms[$p3->[2]-1]->[1];
221       my $z3 = $verts[$p3->[0]-1]->[2]; my $nz3 = $norms[$p3->[2]-1]->[2];
222
223       error ("missing points in face") unless defined($z3);
224
225       if (!defined($nz3)) {
226         my ($nx, $ny, $nz) = face_normal ($x1, $y1, $z1,
227                                           $x2, $y2, $z2,
228                                           $x3, $y3, $z3);
229         $nx1 = $nx2 = $nx3 = $nx;
230         $ny1 = $ny2 = $ny3 = $ny;
231         $nz1 = $nz2 = $nz3 = $nz;
232       }
233
234
235       push @triangles, [$nx1, $ny1, $nz1,  $x1, $y1, $z1,
236                         $nx2, $ny2, $nz2,  $x2, $y2, $z2,
237                         $nx3, $ny3, $nz3,  $x3, $y3, $z3];
238     }
239   }
240
241   return (@triangles);
242 }
243
244
245 sub generate_c($@) {
246   my ($filename, @triangles) = @_;
247
248   my $code = '';
249
250   $code .= "#include \"gllist.h\"\n";
251   $code .= "static const float data[]={\n";
252
253   my $nfaces = $#triangles + 1;
254   my $npoints = $nfaces * 3;
255
256   foreach my $t (@triangles) {
257     my ($nx1, $ny1, $nz1,  $x1, $y1, $z1,
258         $nx2, $ny2, $nz2,  $x2, $y2, $z2,
259         $nx3, $ny3, $nz3,  $x3, $y3, $z3) = @$t;
260     my $lines = sprintf("\t" . "%.6f,%.6f,%.6f," . "%.6f,%.6f,%.6f,\n" .
261                         "\t" . "%.6f,%.6f,%.6f," . "%.6f,%.6f,%.6f,\n" .
262                         "\t" . "%.6f,%.6f,%.6f," . "%.6f,%.6f,%.6f,\n",
263                         $nx1, $ny1, $nz1,  $x1, $y1, $z1,
264                         $nx2, $ny2, $nz2,  $x2, $y2, $z2,
265                         $nx3, $ny3, $nz3,  $x3, $y3, $z3);
266     $lines =~ s/([.\d])0+,/$1,/g;  # lose trailing insignificant zeroes
267     $lines =~ s/\.,/,/g;
268     $lines =~ s/-0,/0,/g;
269
270     $code .= $lines;
271   }
272
273   my $token = $filename;    # guess at a C token from the filename
274   $token =~ s/\<[^<>]*\>//;
275   $token =~ s@^.*/@@;
276   $token =~ s/\.[^.]*$//;
277   $token =~ s/[^a-z\d]/_/gi;
278   $token =~ s/__+/_/g;
279   $token =~ s/^_//g;
280   $token =~ s/_$//g;
281   $token =~ tr [A-Z] [a-z];
282   $token = 'foo' if ($token eq '');
283
284   my $format = 'GL_N3F_V3F';
285   my $primitive = 'GL_TRIANGLES';
286
287   $code =~ s/,\n$//s;
288   $code .= "\n};\n";
289   $code .= "static const struct gllist frame={";
290   $code .= "$format,$primitive,$npoints,data,NULL};\n";
291   $code .= "const struct gllist *$token=&frame;\n";
292
293   print STDERR "$filename: " .
294                (($#triangles+1)*3) . " points, " .
295                (($#triangles+1))   . " faces.\n"
296     if ($verbose);
297
298   return $code;
299 }
300
301
302 sub obj_to_gl($$$) {
303   my ($infile, $outfile, $normalize_p) = @_;
304   my $obj = '';
305   open (my $in, '<', $infile) || error ("$infile: $!");
306   my $filename = ($infile eq '-' ? "<stdin>" : $infile);
307   print STDERR "$progname: reading $filename...\n"
308     if ($verbose);
309   while (<$in>) { $obj .= $_; }
310   close $in;
311
312   $obj =~ s/\r\n/\n/g; # CRLF -> LF
313   $obj =~ s/\r/\n/g;   # CR -> LF
314
315   my @triangles = parse_obj ($filename, $obj, $normalize_p);
316
317   $filename = ($outfile eq '-' ? "<stdout>" : $outfile);
318   my $code = generate_c ($filename, @triangles);
319
320   open (my $out, '>', $outfile) || error ("$outfile: $!");
321   (print $out $code) || error ("$filename: $!");
322   (close $out) || error ("$filename: $!");
323
324   print STDERR "$progname: wrote $filename\n"
325     if ($verbose || $outfile ne '-');
326 }
327
328
329 sub error {
330   ($_) = @_;
331   print STDERR "$progname: $_\n";
332   exit 1;
333 }
334
335 sub usage {
336   print STDERR "usage: $progname [--verbose] [infile [outfile]]\n";
337   exit 1;
338 }
339
340 sub main {
341   my ($infile, $outfile);
342   my $normalize_p = 0;
343   while ($_ = $ARGV[0]) {
344     shift @ARGV;
345     if ($_ eq "--verbose") { $verbose++; }
346     elsif (m/^-v+$/) { $verbose += length($_)-1; }
347     elsif ($_ eq "--normalize") { $normalize_p = 1; }
348     elsif (m/^-./) { usage; }
349     elsif (!defined($infile)) { $infile = $_; }
350     elsif (!defined($outfile)) { $outfile = $_; }
351     else { usage; }
352   }
353
354   $infile  = "-" unless defined ($infile);
355   $outfile = "-" unless defined ($outfile);
356
357   obj_to_gl ($infile, $outfile, $normalize_p);
358 }
359
360 main;
361 exit 0;