git.hungrycats.org Git - xscreensaver/blob - hacks/glx/vrml2gl.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 VRML WRL file, and emits C data suitable for use with OpenGL's
  13 # glInterleavedArrays() and glDrawArrays() routines.
  14 #
  15 # Face normals are computed.
  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 for Wavefront OBJ, converted to VRML 27-Sep-2011.
  23
  24 require 5;
  25 use diagnostics;
  26 use strict;
  27
  28 my $progname = $0; $progname =~ s@.*/@@g;
  29 my ($version) = ('$Revision: 1.2 $' =~ m/\s(\d[.\d]+)\s/s);
  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_vrml_1($$$) {
  76   my ($filename, $body, $normalize_p) = @_;
  77
  78   my @verts = ();    # list of refs of coords, [x, y, z]
  79   my @faces = ();    # list of refs of [ point, point, point, ... ]
  80                      #  where 'point' is a list of indexes into 'verts'.
  81
  82   $body =~ s% \b point \s* \[ (.*?) \] %{
  83     foreach my $point (split (/,/, $1)) {
  84       $point =~ s/^\s+|\s+$//gsi;
  85       next unless $point;
  86       my @p = split(/\s+/, $point);
  87       push @verts, \@p;
  88     }
  89   }%gsexi;
  90
  91   $body =~ s% \b coordIndex \s* \[ (.*?) \] %{
  92     foreach my $face (split (/\s*,-1,?\s*/, $1)) {
  93       $face =~ s/^\s+|\s+$//gsi;
  94       next unless $face;
  95       my @p = split(/\s*,\s*/, $face);
  96       push @faces, \@p;
  97     }
  98   }%gsexi;
  99
 100   return () if ($#verts < 0);
 101
 102   # generate interleaved list of triangle coordinates and normals
 103   #
 104   my @triangles = ();
 105   my $nfaces = $#faces+1;
 106
 107   foreach my $f (@faces) {
 108     # $f is [ p1, p2, p3, ... ]
 109
 110     my @f = @$f;
 111
 112     error ("too few points in face") if ($#f < 2);
 113     my $p1 = shift @f;
 114
 115     # If there are more than 3 points, do a triangle fan from the first one:
 116     # [1 2 3] [1 3 4] [1 4 5] etc.  Doesn't always work with convex shapes.
 117
 118     while ($#f) {
 119       my $p2 = shift @f;
 120       my $p3 = $f[0];
 121
 122       my ($pp1, $pp2, $pp3) = ($p1, $p2, $p3);
 123       # Reverse the winding order.
 124 #      ($pp1, $pp2, $pp3) = ($pp3, $pp2, $pp1);
 125
 126       my $x1 = $verts[$pp1]->[0];
 127       my $y1 = $verts[$pp1]->[1];
 128       my $z1 = $verts[$pp1]->[2];
 129
 130       my $x2 = $verts[$pp2]->[0];
 131       my $y2 = $verts[$pp2]->[1];
 132       my $z2 = $verts[$pp2]->[2];
 133
 134       my $x3 = $verts[$pp3]->[0];
 135       my $y3 = $verts[$pp3]->[1];
 136       my $z3 = $verts[$pp3]->[2];
 137
 138       error ("missing points in face") unless defined($z3);
 139
 140       my ($nx, $ny, $nz) = face_normal ($x1, $y1, $z1,
 141                                         $x2, $y2, $z2,
 142                                         $x3, $y3, $z3);
 143
 144       push @triangles, [$nx, $ny, $nz,  $x1, $y1, $z1,
 145                         $nx, $ny, $nz,  $x2, $y2, $z2,
 146                         $nx, $ny, $nz,  $x3, $y3, $z3];
 147     }
 148   }
 149
 150   return (@triangles);
 151 }
 152
 153
 154 sub parse_vrml($$$) {
 155   my ($filename, $body, $normalize_p) = @_;
 156
 157   my @triangles = ();
 158
 159   $body =~ s/\s*\#.*$//gmi;  # comments
 160
 161   # Lose 2D imagery
 162   $body =~ s/\bIndexedLineSet \s* { \s* coordIndex \s* \[ .*? \] \s* }//gsix;
 163
 164   $body =~ s/(\bSeparator\b)/\001$1/g;
 165
 166   foreach my $sec (split (m/\001/, $body)) {
 167     push @triangles, parse_vrml_1 ($filename, $sec, $normalize_p);
 168   }
 169
 170
 171   # find bounding box, and normalize
 172   #
 173   if ($normalize_p || $verbose) {
 174     my $minx =  999999999;
 175     my $miny =  999999999;
 176     my $minz =  999999999;
 177     my $maxx = -999999999;
 178     my $maxy = -999999999;
 179     my $maxz = -999999999;
 180     my $i = 0;
 181
 182     foreach my $t (@triangles) {
 183       my ($nx1, $ny1, $nz1,  $x1, $y1, $z1,
 184           $nx2, $ny2, $nz2,  $x2, $y2, $z2,
 185           $nx3, $ny3, $nz3,  $x3, $y3, $z3) = @$t;
 186
 187       foreach my $x ($x1, $x2, $x3) {
 188         $minx = $x if ($x < $minx);
 189         $maxx = $x if ($x > $maxx);
 190       }
 191       foreach my $y ($y1, $y2, $y3) {
 192         $miny = $y if ($y < $miny);
 193         $maxy = $y if ($y > $maxy);
 194       }
 195       foreach my $z ($z1, $z2, $z3) {
 196         $minz = $z if ($z < $minz);
 197         $maxz = $z if ($z > $maxz);
 198       }
 199     }
 200
 201     my $w = ($maxx - $minx);
 202     my $h = ($maxy - $miny);
 203     my $d = ($maxz - $minz);
 204     my $sizea = ($w > $h ? $w : $h);
 205     my $sizeb = ($w > $d ? $w : $d);
 206     my $size = ($sizea > $sizeb ? $sizea : $sizeb);
 207
 208     print STDERR "$progname: bbox is " .
 209                   sprintf("%.2f x %.2f x %.2f\n", $w, $h, $d)
 210        if ($verbose);
 211
 212     if ($normalize_p) {
 213       $w /= $size;
 214       $h /= $size;
 215       $d /= $size;
 216       print STDERR "$progname: dividing by $size for bbox of " .
 217                   sprintf("%.2f x %.2f x %.2f\n", $w, $h, $d)
 218         if ($verbose);
 219
 220       foreach my $t (@triangles) {
 221         my @t = @$t;
 222         $t[3]  /= $size; $t[4]  /= $size; $t[5]  /= $size;
 223         $t[9]  /= $size; $t[10] /= $size; $t[11] /= $size;
 224         $t[15] /= $size; $t[16] /= $size; $t[17] /= $size;
 225         $t = \@t;
 226       }
 227     }
 228   }
 229
 230   return @triangles;
 231 }
 232
 233
 234 sub generate_c($@) {
 235   my ($filename, @triangles) = @_;
 236
 237   my $code = '';
 238
 239   $code .= "#include \"gllist.h\"\n";
 240   $code .= "static const float data[]={\n";
 241
 242   my $nfaces = $#triangles + 1;
 243   my $npoints = $nfaces * 3;
 244
 245   foreach my $t (@triangles) {
 246     my ($nx1, $ny1, $nz1,  $x1, $y1, $z1,
 247         $nx2, $ny2, $nz2,  $x2, $y2, $z2,
 248         $nx3, $ny3, $nz3,  $x3, $y3, $z3) = @$t;
 249     my $lines = sprintf("\t" . "%.6f,%.6f,%.6f," . "%.6f,%.6f,%.6f,\n" .
 250                         "\t" . "%.6f,%.6f,%.6f," . "%.6f,%.6f,%.6f,\n" .
 251                         "\t" . "%.6f,%.6f,%.6f," . "%.6f,%.6f,%.6f,\n",
 252                         $nx1, $ny1, $nz1,  $x1, $y1, $z1,
 253                         $nx2, $ny2, $nz2,  $x2, $y2, $z2,
 254                         $nx3, $ny3, $nz3,  $x3, $y3, $z3);
 255     $lines =~ s/([.\d])0+,/$1,/g;  # lose trailing insignificant zeroes
 256     $lines =~ s/\.,/,/g;
 257     $lines =~ s/-0,/0,/g;
 258
 259     $code .= $lines;
 260   }
 261
 262   my $token = $filename;    # guess at a C token from the filename
 263   $token =~ s/\<[^<>]*\>//;
 264   $token =~ s@^.*/@@;
 265   $token =~ s/\.[^.]*$//;
 266   $token =~ s/[^a-z\d]/_/gi;
 267   $token =~ s/__+/_/g;
 268   $token =~ s/^_//g;
 269   $token =~ s/_$//g;
 270   $token =~ tr [A-Z] [a-z];
 271   $token = 'foo' if ($token eq '');
 272
 273   my $format = 'GL_N3F_V3F';
 274   my $primitive = 'GL_TRIANGLES';
 275
 276   $code =~ s/,\n$//s;
 277   $code .= "\n};\n";
 278   $code .= "static const struct gllist frame={";
 279   $code .= "$format,$primitive,$npoints,data,NULL};\n";
 280   $code .= "const struct gllist *$token=&frame;\n";
 281
 282   print STDERR "$filename: " .
 283                (($#triangles+1)*3) . " points, " .
 284                (($#triangles+1))   . " faces.\n"
 285     if ($verbose);
 286
 287   return $code;
 288 }
 289
 290
 291 sub vrml_to_gl($$$) {
 292   my ($infile, $outfile, $normalize_p) = @_;
 293   my $body = '';
 294
 295   my $in;
 296   if ($infile eq '-') {
 297     $in = *STDIN;
 298   } else {
 299     open ($in, '<', $infile) || error ("$infile: $!");
 300   }
 301   my $filename = ($infile eq '-' ? "<stdin>" : $infile);
 302   print STDERR "$progname: reading $filename...\n"
 303     if ($verbose);
 304   while (<$in>) { $body .= $_; }
 305   close $in;
 306
 307   $body =~ s/\r\n/\n/g; # CRLF -> LF
 308   $body =~ s/\r/\n/g;   # CR -> LF
 309
 310   my @triangles = parse_vrml ($filename, $body, $normalize_p);
 311
 312   $filename = ($outfile eq '-' ? "<stdout>" : $outfile);
 313   my $code = generate_c ($filename, @triangles);
 314
 315   my $out;
 316   if ($outfile eq '-') {
 317     $out = *STDOUT;
 318   } else {
 319     open ($out, '>', $outfile) || error ("$outfile: $!");
 320   }
 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   vrml_to_gl ($infile, $outfile, $normalize_p);
 358 }
 359
 360 main;
 361 exit 0;