git.hungrycats.org Git - xscreensaver/blob - hacks/glx/wfront2gl.pl

   1 #!/usr/bin/perl -w
   2 # Copyright © 2003-2012 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) = ('$Revision: 1.6 $' =~ m/\s(\d[.\d]+)\s/s);
  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;