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