git.hungrycats.org Git - xscreensaver/blob - 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;