git.maemo.org Git - xscreensaver/blob - xscreensaver/hacks/glx/dxf2gl.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 DXF file, and emits C data suitable for use with OpenGL's
  13 # glInterleavedArrays() and glDrawArrays() routines.
  14 #
  15 # Options:
  16 #
  17 #    --normalize      Compute the bounding box of the object, and scale all
  18 #                     coordinates so that the object fits inside a unit cube.
  19 #
  20 #    --smooth         When computing normals for the vertexes, average the
  21 #                     normals at any edge which is less than 90 degrees.
  22 #                     If this option is not specified, planar normals will be
  23 #                     used, resulting in a "faceted" object.
  24 #
  25 # Created:  8-Mar-2003.
  26
  27 require 5;
  28 use diagnostics;
  29 use strict;
  30
  31 my $progname = $0; $progname =~ s@.*/@@g;
  32 my $version = q{ $Revision: 1.2 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
  33
  34 my $verbose = 0;
  35
  36
  37 # convert a vector to a unit vector
  38 sub normalize {
  39   my ($x, $y, $z) = @_;
  40   my $L = sqrt (($x * $x) + ($y * $y) + ($z * $z));
  41   if ($L != 0) {
  42     $x /= $L;
  43     $y /= $L;
  44     $z /= $L;
  45   } else {
  46     $x = $y = $z = 0;
  47   }
  48   return ($x, $y, $z);
  49 }
  50
  51
  52 # Calculate the unit normal at p0 given two other points p1,p2 on the
  53 # surface.  The normal points in the direction of p1 crossproduct p2.
  54 #
  55 sub face_normal {
  56   my ($p0x, $p0y, $p0z,
  57       $p1x, $p1y, $p1z,
  58       $p2x, $p2y, $p2z) = @_;
  59
  60   my ($nx,  $ny,  $nz);
  61   my ($pax, $pay, $paz);
  62   my ($pbx, $pby, $pbz);
  63
  64   $pax = $p1x - $p0x;
  65   $pay = $p1y - $p0y;
  66   $paz = $p1z - $p0z;
  67   $pbx = $p2x - $p0x;
  68   $pby = $p2y - $p0y;
  69   $pbz = $p2z - $p0z;
  70   $nx = $pay * $pbz - $paz * $pby;
  71   $ny = $paz * $pbx - $pax * $pbz;
  72   $nz = $pax * $pby - $pay * $pbx;
  73
  74   return (normalize ($nx, $ny, $nz));
  75 }
  76
  77
  78 # why this isn't in perlfunc, I don't know.
  79 sub acos { atan2( sqrt(1 - $_[0] * $_[0]), $_[0] ) }
  80 my $pi = 3.141592653589793;
  81 my $radians_to_degrees = 180.0 / $pi;
  82
  83 # Calculate the angle (in degrees) between two vectors.
  84 #
  85 sub vector_angle {
  86   my ($x1, $y1, $z1,
  87       $x2, $y2, $z2) = @_;
  88
  89   my $L1 = sqrt ($x1*$x1 + $y1*$y1 + $z1*$z1);
  90   my $L2 = sqrt ($x2*$x2 + $y2*$y2 + $z2*$z2);
  91
  92   return 0 if ($L1 == 0 || $L2 == 0);
  93   return 0 if ($x1 == $x2 && $y1 == $y2 && $z1 == $z2);
  94
  95   # dot product of two vectors is defined as:
  96   #   $L1 * $L1 * cos(angle between vectors)
  97   # and is also defined as:
  98   #   $x1*$x2 + $y1*$y2 + $z1*$z2
  99   # so:
 100   #   $L1 * $L1 * cos($angle) = $x1*$x2 + $y1*$y2 + $z1*$z2
 101   #   cos($angle) = ($x1*$x2 + $y1*$y2 + $z1*$z2) / ($L1 * $L2)
 102   #   $angle = acos (($x1*$x2 + $y1*$y2 + $z1*$z2) / ($L1 * $L2));
 103   #
 104   my $cos = ($x1*$x2 + $y1*$y2 + $z1*$z2) / ($L1 * $L2);
 105   $cos = 1 if ($cos > 1);  # avoid fp rounding error (1.000001 => sqrt error)
 106   my $angle = acos ($cos);
 107
 108   return ($angle * $radians_to_degrees);
 109 }
 110
 111 # given a list of triangles ( [ X1, Y1, Z1,  X2, Y2, Z2,  X3, Y3, Z3, ]+ )
 112 # returns a list of the normals for each vertex.
 113 #
 114 sub compute_vertex_normals {
 115   my (@points) = @_;
 116   my $npoints = ($#points+1) / 3;
 117   my $nfaces = $npoints / 3;
 118
 119   my @face_normals = ();
 120   my %point_faces;
 121
 122   for (my $i = 0; $i < $nfaces; $i++) {
 123     my ($ax, $ay, $az,  $bx, $by, $bz,  $cx, $cy, $cz) =
 124       @points[($i*9) .. ($i*9)+8];
 125
 126     # store the normal for each face in the $face_normals array
 127     # indexed by face number.
 128     #
 129     my @norm = face_normal ($ax, $ay, $az,
 130                             $bx, $by, $bz,
 131                             $cx, $cy, $cz);
 132     $face_normals[$i] = \@norm;
 133
 134     # store in the %point_faces hash table a list of every face number
 135     # in which a point participates
 136
 137     my $p;
 138     my @flist;
 139
 140     $p = "$ax $ay $az";
 141     @flist = (defined($point_faces{$p}) ? @{$point_faces{$p}} : ());
 142     push @flist, $i;
 143     $point_faces{$p} = \@flist;
 144
 145     $p = "$bx $by $bz";
 146     @flist = (defined($point_faces{$p}) ? @{$point_faces{$p}} : ());
 147     push @flist, $i;
 148     $point_faces{$p} = \@flist;
 149
 150     $p = "$cx $cy $cz";
 151     @flist = (defined($point_faces{$p}) ? @{$point_faces{$p}} : ());
 152     push @flist, $i;
 153     $point_faces{$p} = \@flist;
 154   }
 155
 156
 157   # compute the normal for each vertex of each face.
 158   # (these points are not unique -- because there might be multiple
 159   # normals associated with the same vertex for different faces,
 160   # in the case where it's a sharp angle.)
 161   #
 162   my @normals = ();
 163   for (my $i = 0; $i < $nfaces; $i++) {
 164     my @verts = @points[($i*9) .. ($i*9)+8];
 165     error ("overshot in points?") unless defined($verts[8]);
 166
 167     my @norm = @{$face_normals[$i]};
 168     error ("no normal $i?") unless defined($norm[2]);
 169
 170     # iterate over the (three) vertexes in this face.
 171     #
 172     for (my $j = 0; $j < 3; $j++) {
 173       my ($x, $y, $z) = @verts[($j*3) .. ($j*3)+2];
 174       error ("overshot in verts?") unless defined($z);
 175
 176       # Iterate over the faces in which this point participates.
 177       # This face's normal is the average of the normals of those faces.
 178       # Except, faces are ignored if any point in them is at more than
 179       # a 90 degree angle from the zeroth face (arbitrarily.)
 180       #
 181       my ($nx, $ny, $nz) = (0, 0, 0);
 182       my @faces = @{$point_faces{"$x $y $z"}};
 183       foreach my $fn (@faces) {
 184         my ($ax, $ay, $az,  $bx, $by, $bz,  $cx, $cy, $cz) =
 185           @points[($fn*9) .. ($fn*9)+8];
 186         my @fnorm = @{$face_normals[$fn]};
 187
 188         # ignore any adjascent faces that are more than 90 degrees off.
 189         my $angle = vector_angle (@norm, @fnorm);
 190         next if ($angle >= 90);
 191
 192         $nx += $fnorm[0];
 193         $ny += $fnorm[1];
 194         $nz += $fnorm[2];
 195       }
 196
 197       push @normals, normalize ($nx, $ny, $nz);
 198     }
 199   }
 200
 201   return @normals;
 202 }
 203
 204
 205
 206 sub parse_dxf {
 207   my ($filename, $dxf, $normalize_p) = @_;
 208
 209   $_ = $dxf;
 210   my ($points_txt, $coords_txt);
 211   my $vvers;
 212
 213   $dxf =~ s/([^\n]*)\n([^\n]*)\n/$1\t$2\n/g;  # join even and odd lines
 214
 215   my @triangles = ();
 216
 217   my @items = split (/\n/, $dxf);
 218   while ($#items >= 0) {
 219
 220     $_ = shift @items;
 221
 222     if      (m/^\s* 0 \s+ SECTION \b/x) {
 223     } elsif (m/^\s* 2 \s+ HEADER \b/x) {
 224     } elsif (m/^\s* 0 \s+ ENDSEC \b/x) {
 225     } elsif (m/^\s* 2 \s+ ENTITIES \b/x) {
 226     } elsif (m/^\s* 0 \s+ EOF \b/x) {
 227     } elsif (m/^\s* 0 \s+ 3DFACE \b/x) {
 228
 229       my @points = ();
 230       my $pc = 0;
 231
 232       while ($#items >= 0) {
 233         $_ = shift @items;  # get next line
 234
 235         my $d = '(-?\d+\.?\d+)';
 236         if (m/^\s* 8 \b/x) {        # layer name
 237         } elsif (m/^\s* 62 \b/x) {  # color number
 238
 239         } elsif (m/^\s* 10 \s+ $d/xo) { $pc++; $points[ 0] = $1;    # X1
 240         } elsif (m/^\s* 20 \s+ $d/xo) { $pc++; $points[ 1] = $1;    # Y1
 241         } elsif (m/^\s* 30 \s+ $d/xo) { $pc++; $points[ 2] = $1;    # Z1
 242
 243         } elsif (m/^\s* 11 \s+ $d/xo) { $pc++; $points[ 3] = $1;    # X2
 244         } elsif (m/^\s* 21 \s+ $d/xo) { $pc++; $points[ 4] = $1;    # Y2
 245         } elsif (m/^\s* 31 \s+ $d/xo) { $pc++; $points[ 5] = $1;    # Z2
 246
 247         } elsif (m/^\s* 12 \s+ $d/xo) { $pc++; $points[ 6] = $1;    # X3
 248         } elsif (m/^\s* 22 \s+ $d/xo) { $pc++; $points[ 7] = $1;    # Y3
 249         } elsif (m/^\s* 32 \s+ $d/xo) { $pc++; $points[ 8] = $1;    # Z3
 250
 251         } elsif (m/^\s* 13 \s+ $d/xo) { $pc++; $points[ 9] = $1;    # X4
 252         } elsif (m/^\s* 23 \s+ $d/xo) { $pc++; $points[10] = $1;    # Y4
 253         } elsif (m/^\s* 33 \s+ $d/xo) { $pc++; $points[11] = $1;    # Z4
 254         } else {
 255           error ("$filename: unknown 3DFACE entry: $_\n");
 256         }
 257
 258         last if ($pc >= 12);
 259       }
 260
 261       if ($points[6] != $points[9] ||
 262           $points[7] != $points[10] ||
 263           $points[8] != $points[11]) {
 264         error ("$filename: got a quad, not a triangle\n");
 265       } else {
 266         @points = @points[0 .. 8];
 267       }
 268
 269       foreach (@points) { $_ += 0; }    # convert strings to numbers
 270
 271       push @triangles, @points;
 272
 273     } else {
 274       error ("$filename: unknown: $_\n");
 275     }
 276   }
 277
 278
 279   my $npoints = ($#triangles+1) / 3;
 280
 281
 282   # find bounding box, and normalize
 283   #
 284   if ($normalize_p || $verbose) {
 285     my $minx =  999999999;
 286     my $miny =  999999999;
 287     my $minz =  999999999;
 288     my $maxx = -999999999;
 289     my $maxy = -999999999;
 290     my $maxz = -999999999;
 291     my $i = 0;
 292     foreach my $n (@triangles) {
 293       if    ($i == 0) { $minx = $n if ($n < $minx);
 294                         $maxx = $n if ($n > $maxx); }
 295       elsif ($i == 1) { $miny = $n if ($n < $miny);
 296                         $maxy = $n if ($n > $maxy); }
 297       else            { $minz = $n if ($n < $minz);
 298                         $maxz = $n if ($n > $maxz); }
 299       $i = 0 if (++$i == 3);
 300     }
 301
 302     my $w = ($maxx - $minx);
 303     my $h = ($maxy - $miny);
 304     my $d = ($maxz - $minz);
 305     my $sizea = ($w > $h ? $w : $h);
 306     my $sizeb = ($w > $d ? $w : $d);
 307     my $size = ($sizea > $sizeb ? $sizea : $sizeb);
 308
 309     print STDERR "$progname: $filename: bbox is " .
 310                   sprintf("%.2f x %.2f x %.2f\n", $w, $h, $d)
 311        if ($verbose);
 312
 313     if ($normalize_p) {
 314       $w /= $size;
 315       $h /= $size;
 316       $d /= $size;
 317       print STDERR "$progname: $filename: dividing by $size for bbox of " .
 318                   sprintf("%.2f x %.2f x %.2f\n", $w, $h, $d)
 319         if ($verbose);
 320       foreach my $n (@triangles) {
 321         $n /= $size;
 322       }
 323     }
 324   }
 325
 326   return (@triangles);
 327 }
 328
 329
 330 sub generate_c {
 331   my ($filename, $smooth_p, @points) = @_;
 332
 333   my $ccw_p = 1;  # counter-clockwise winding rule for computing normals
 334
 335   my $code = '';
 336
 337   $code .= "#include \"gllist.h\"\n";
 338   $code .= "static const float data[]={\n";
 339
 340   my $npoints = ($#points + 1) / 3;
 341   my $nfaces = $npoints / 3;
 342
 343   my @normals;
 344   if ($smooth_p) {
 345     @normals = compute_vertex_normals (@points);
 346
 347     if ($#normals != $#points) {
 348       error ("computed " . (($#normals+1)/3) . " normals for " .
 349              (($#points+1)/3) . " points?");
 350     }
 351   }
 352
 353   for (my $i = 0; $i < $nfaces; $i++) {
 354     my $ax = $points[$i*9];
 355     my $ay = $points[$i*9+1];
 356     my $az = $points[$i*9+2];
 357
 358     my $bx = $points[$i*9+3];
 359     my $by = $points[$i*9+4];
 360     my $bz = $points[$i*9+5];
 361
 362     my $cx = $points[$i*9+6];
 363     my $cy = $points[$i*9+7];
 364     my $cz = $points[$i*9+8];
 365
 366     my ($nax, $nay, $naz,
 367         $nbx, $nby, $nbz,
 368         $ncx, $ncy, $ncz);
 369
 370     if ($smooth_p) {
 371       $nax = $normals[$i*9];
 372       $nay = $normals[$i*9+1];
 373       $naz = $normals[$i*9+2];
 374
 375       $nbx = $normals[$i*9+3];
 376       $nby = $normals[$i*9+4];
 377       $nbz = $normals[$i*9+5];
 378
 379       $ncx = $normals[$i*9+6];
 380       $ncy = $normals[$i*9+7];
 381       $ncz = $normals[$i*9+8];
 382
 383     } else {
 384       if ($ccw_p) {
 385         ($nax, $nay, $naz) = face_normal ($ax, $ay, $az,
 386                                           $bx, $by, $bz,
 387                                           $cx, $cy, $cz);
 388       } else {
 389         ($nax, $nay, $naz) = face_normal ($ax, $ay, $az,
 390                                           $cx, $cy, $cz,
 391                                           $bx, $by, $bz);
 392       }
 393       ($nbx, $nby, $nbz) = ($nax, $nay, $naz);
 394       ($ncx, $ncy, $ncz) = ($nax, $nay, $naz);
 395     }
 396
 397     my $lines = sprintf("\t" . "%.6f,%.6f,%.6f," . "%.6f,%.6f,%.6f,\n" .
 398                         "\t" . "%.6f,%.6f,%.6f," . "%.6f,%.6f,%.6f,\n" .
 399                         "\t" . "%.6f,%.6f,%.6f," . "%.6f,%.6f,%.6f,\n",
 400                         $nax, $nay, $naz,  $ax, $ay, $az,
 401                         $nbx, $nby, $nbz,  $bx, $by, $bz,
 402                         $ncx, $ncy, $ncz,  $cx, $cy, $cz);
 403     $lines =~ s/([.\d])0+,/$1,/g;  # lose trailing insignificant zeroes
 404     $lines =~ s/\.,/,/g;
 405
 406     $code .= $lines;
 407   }
 408
 409   my $token = $filename;    # guess at a C token from the filename
 410   $token =~ s/\<[^<>]*\>//;
 411   $token =~ s@^.*/@@;
 412   $token =~ s/\.[^.]*$//;
 413   $token =~ s/[^a-z\d]/_/gi;
 414   $token =~ s/__+/_/g;
 415   $token =~ s/^_//g;
 416   $token =~ s/_$//g;
 417   $token =~ tr [A-Z] [a-z];
 418   $token = 'foo' if ($token eq '');
 419
 420   my $format = 'GL_N3F_V3F';
 421   my $primitive = 'GL_TRIANGLES';
 422
 423   $code =~ s/,\n$//s;
 424   $code .= "\n};\n";
 425   $code .= "static const struct gllist frame={";
 426   $code .= "$format,$primitive,$npoints,data,NULL};\n";
 427   $code .= "const struct gllist *$token=&frame;\n";
 428
 429   print STDERR "$progname: $filename: " .
 430                (($#points+1)/3) . " points, " .
 431                (($#points+1)/9) . " faces.\n"
 432     if ($verbose);
 433
 434   return $code;
 435 }
 436
 437
 438 sub dxf_to_gl {
 439   my ($infile, $outfile, $smooth_p, $normalize_p) = @_;
 440   local *IN;
 441   my $dxf = '';
 442   open (IN, "<$infile") || error ("$infile: $!");
 443   my $filename = ($infile eq '-' ? "<stdin>" : $infile);
 444   print STDERR "$progname: reading $filename...\n"
 445     if ($verbose);
 446   while (<IN>) { $dxf .= $_; }
 447   close IN;
 448
 449   $dxf =~ s/\r\n/\n/g; # CRLF -> LF
 450   $dxf =~ s/\r/\n/g;   # CR -> LF
 451
 452   my @data = parse_dxf ($filename, $dxf, $normalize_p);
 453
 454   $filename = ($outfile eq '-' ? "<stdout>" : $outfile);
 455   my $code = generate_c ($filename, $smooth_p, @data);
 456
 457   local *OUT;
 458   open (OUT, ">$outfile") || error ("$outfile: $!");
 459   print OUT $code || error ("$filename: $!");
 460   close OUT || error ("$filename: $!");
 461
 462   print STDERR "$progname: wrote $filename\n"
 463     if ($verbose || $outfile ne '-');
 464 }
 465
 466
 467 sub error {
 468   ($_) = @_;
 469   print STDERR "$progname: $_\n";
 470   exit 1;
 471 }
 472
 473 sub usage {
 474   print STDERR "usage: $progname [--verbose] [--smooth] [infile [outfile]]\n";
 475   exit 1;
 476 }
 477
 478 sub main {
 479   my ($infile, $outfile);
 480   my $normalize_p = 0;
 481   my $smooth_p = 0;
 482   while ($_ = $ARGV[0]) {
 483     shift @ARGV;
 484     if ($_ eq "--verbose") { $verbose++; }
 485     elsif (m/^-v+$/) { $verbose += length($_)-1; }
 486     elsif ($_ eq "--normalize") { $normalize_p = 1; }
 487     elsif ($_ eq "--smooth") { $smooth_p = 1; }
 488     elsif (m/^-./) { usage; }
 489     elsif (!defined($infile)) { $infile = $_; }
 490     elsif (!defined($outfile)) { $outfile = $_; }
 491     else { usage; }
 492   }
 493
 494   $infile  = "-" unless defined ($infile);
 495   $outfile = "-" unless defined ($outfile);
 496
 497   dxf_to_gl ($infile, $outfile, $smooth_p, $normalize_p);
 498 }
 499
 500 main;
 501 exit 0;