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

   1 #!/usr/bin/perl -w
   2 # Copyright © 2003-2014 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 #    --wireframe      Emit lines instead of faces.
  26 #
  27 #    --layers         Emit a separate set of polygons for each layer in the
  28 #                     input file, instead of emitting the whole file as a
  29 #                     single unit.
  30 #
  31 # Created:  8-Mar-2003.
  32
  33 require 5;
  34 use diagnostics;
  35 use strict;
  36
  37 use POSIX qw(mktime strftime);
  38 use Math::Trig qw(acos);
  39 use Text::Wrap;
  40
  41 my $progname = $0; $progname =~ s@.*/@@g;
  42 my ($version) = ('$Revision: 1.11 $' =~ m/\s(\d[.\d]+)\s/s);
  43
  44 my $verbose = 0;
  45
  46
  47 # convert a vector to a unit vector
  48 sub normalize($$$) {
  49   my ($x, $y, $z) = @_;
  50   my $L = sqrt (($x * $x) + ($y * $y) + ($z * $z));
  51   if ($L != 0) {
  52     $x /= $L;
  53     $y /= $L;
  54     $z /= $L;
  55   } else {
  56     $x = $y = $z = 0;
  57   }
  58   return ($x, $y, $z);
  59 }
  60
  61
  62 # Calculate the unit normal at p0 given two other points p1,p2 on the
  63 # surface.  The normal points in the direction of p1 crossproduct p2.
  64 #
  65 sub face_normal($$$$$$$$$) {
  66   my ($p0x, $p0y, $p0z,
  67       $p1x, $p1y, $p1z,
  68       $p2x, $p2y, $p2z) = @_;
  69
  70   my ($nx,  $ny,  $nz);
  71   my ($pax, $pay, $paz);
  72   my ($pbx, $pby, $pbz);
  73
  74   $pax = $p1x - $p0x;
  75   $pay = $p1y - $p0y;
  76   $paz = $p1z - $p0z;
  77   $pbx = $p2x - $p0x;
  78   $pby = $p2y - $p0y;
  79   $pbz = $p2z - $p0z;
  80   $nx = $pay * $pbz - $paz * $pby;
  81   $ny = $paz * $pbx - $pax * $pbz;
  82   $nz = $pax * $pby - $pay * $pbx;
  83
  84   return (normalize ($nx, $ny, $nz));
  85 }
  86
  87
  88 my $pi = 3.141592653589793;
  89 my $radians_to_degrees = 180.0 / $pi;
  90
  91 # Calculate the angle (in degrees) between two vectors.
  92 #
  93 sub vector_angle($$$$$$) {
  94   my ($x1, $y1, $z1,
  95       $x2, $y2, $z2) = @_;
  96
  97   my $L1 = sqrt ($x1*$x1 + $y1*$y1 + $z1*$z1);
  98   my $L2 = sqrt ($x2*$x2 + $y2*$y2 + $z2*$z2);
  99
 100   return 0 if ($L1 == 0 || $L2 == 0);
 101   return 0 if ($x1 == $x2 && $y1 == $y2 && $z1 == $z2);
 102
 103   # dot product of two vectors is defined as:
 104   #   $L1 * $L1 * cos(angle between vectors)
 105   # and is also defined as:
 106   #   $x1*$x2 + $y1*$y2 + $z1*$z2
 107   # so:
 108   #   $L1 * $L1 * cos($angle) = $x1*$x2 + $y1*$y2 + $z1*$z2
 109   #   cos($angle) = ($x1*$x2 + $y1*$y2 + $z1*$z2) / ($L1 * $L2)
 110   #   $angle = acos (($x1*$x2 + $y1*$y2 + $z1*$z2) / ($L1 * $L2));
 111   #
 112   my $cos = ($x1*$x2 + $y1*$y2 + $z1*$z2) / ($L1 * $L2);
 113   $cos = 1 if ($cos > 1);  # avoid fp rounding error (1.000001 => sqrt error)
 114   my $angle = acos ($cos);
 115
 116   return ($angle * $radians_to_degrees);
 117 }
 118
 119
 120 # given a list of triangles ( [ X1, Y1, Z1,  X2, Y2, Z2,  X3, Y3, Z3, ]+ )
 121 # returns a list of the normals for each vertex.  These are the smoothed
 122 # normals: the average of the normals of the participating faces.
 123 #
 124 sub compute_vertex_normals(@) {
 125   my (@points) = @_;
 126   my $npoints = ($#points+1) / 3;
 127   my $nfaces = $npoints / 3;
 128
 129   my @face_normals = ();
 130   my %point_faces;
 131
 132   for (my $i = 0; $i < $nfaces; $i++) {
 133     my ($ax, $ay, $az,  $bx, $by, $bz,  $cx, $cy, $cz) =
 134       @points[($i*9) .. ($i*9)+8];
 135
 136     # store the normal for each face in the $face_normals array
 137     # indexed by face number.
 138     #
 139     my @norm = face_normal ($ax, $ay, $az,
 140                             $bx, $by, $bz,
 141                             $cx, $cy, $cz);
 142     $face_normals[$i] = \@norm;
 143
 144     # store in the %point_faces hash table a list of every face number
 145     # in which a point participates
 146
 147     foreach my $p ("$ax $ay $az", "$bx $by $bz", "$cx $cy $cz") {
 148       my @flist = (defined($point_faces{$p}) ? @{$point_faces{$p}} : ());
 149       push @flist, $i;
 150       $point_faces{$p} = \@flist;
 151     }
 152   }
 153
 154
 155   # compute the normal for each vertex of each face.
 156   # (these points are not unique -- because there might be multiple
 157   # normals associated with the same vertex for different faces,
 158   # in the case where it's a sharp angle.)
 159   #
 160   my @normals = ();
 161   for (my $i = 0; $i < $nfaces; $i++) {
 162     my @verts = @points[($i*9) .. ($i*9)+8];
 163     error ("overshot in points?") unless defined($verts[8]);
 164
 165     my @norm = @{$face_normals[$i]};
 166     error ("no normal $i?") unless defined($norm[2]);
 167
 168     # iterate over the (three) vertexes in this face.
 169     #
 170     for (my $j = 0; $j < 3; $j++) {
 171       my ($x, $y, $z) = @verts[($j*3) .. ($j*3)+2];
 172       error ("overshot in verts?") unless defined($z);
 173
 174       # Iterate over the faces in which this point participates.
 175       # But ignore any other faces that are at more than an N degree
 176       # angle from this point's face. Those are sharp edges.
 177       #
 178       my ($nx, $ny, $nz) = (0, 0, 0);
 179       my @faces = @{$point_faces{"$x $y $z"}};
 180       foreach my $fn (@faces) {
 181         my ($ax, $ay, $az,  $bx, $by, $bz,  $cx, $cy, $cz) =
 182           @points[($fn*9) .. ($fn*9)+8];
 183         my @fnorm = @{$face_normals[$fn]};
 184
 185         # ignore any adjascent faces that are more than N degrees off.
 186         my $angle = vector_angle ($norm[0],  $norm[1],  $norm[2],
 187                                   $fnorm[0], $fnorm[1], $fnorm[2]);
 188         next if ($angle >= 30);
 189
 190         $nx += $fnorm[0];
 191         $ny += $fnorm[1];
 192         $nz += $fnorm[2];
 193       }
 194
 195       push @normals, normalize ($nx, $ny, $nz);
 196     }
 197   }
 198
 199   return @normals;
 200 }
 201
 202
 203 sub parse_dxf($$$$$) {
 204   my ($filename, $dxf, $normalize_p, $wireframe_p, $layers_p) = @_;
 205
 206   $dxf =~ s/\r\n/\n/gs;                         # CRLF
 207   $dxf =~ s/^[ \t\n]+|[ \t\n]+$//s;             # leading/trailing whitespace
 208
 209   # Convert whitespace within a line to _, e.g., "ObjectDBX Classes".
 210   # What the hell is up with this file format!
 211   1 while ($dxf =~ s/([^ \t\n])[ \t]+([^ \t\n])/$1_$2/gs);
 212
 213   $dxf =~ s/\r/\n/gs;
 214
 215   # Turn blank lines into "", e.g., "$DIMBLK \n 1 \n \n 9 \n"
 216   $dxf =~ s/\n\n/\n""\n/gs;
 217
 218   my @tokens = split (/[ \t\n]+/, $dxf);        # tokenize
 219
 220   my @entities = ();                            # parse
 221   while (@tokens) {
 222     my @elts = ();
 223     my $key = shift @tokens;                    # sectionize at "0 WORD"
 224     do {
 225       my $val = shift @tokens;
 226       push @elts, [ $key, $val ];               # contents are [CODE VAL]
 227       $key = shift @tokens;
 228     } while ($key && $key ne 0);
 229     unshift @tokens, $key if defined($key);
 230     push @entities, \@elts;
 231   }
 232   my %triangles;   # list of points, indexed by layer name
 233   my %lines;
 234   my $error_count = 0;
 235
 236   foreach my $entity (@entities) {
 237     my $header = shift @$entity;
 238     my ($code, $name) = @$header;
 239
 240     if ($name eq 'SECTION' ||
 241         $name eq 'HEADER' ||
 242         $name eq 'ENDSEC' ||
 243         $name eq 'EOF') {
 244       print STDERR "$progname: $filename: ignoring \"$code $name\"\n"
 245         if ($verbose > 1);
 246
 247     } elsif ($name eq '3DFACE') {
 248
 249       my @points = ();
 250       my $pc = 0;
 251       my $layer = '';
 252
 253       foreach my $entry (@$entity) {
 254         my ($key, $val) = @$entry;
 255         if      ($key eq 8)  { $layer = $val;                   # layer name
 256
 257         } elsif ($key eq 10) { $pc++; $points[0] = $val;        # X1
 258         } elsif ($key eq 20) { $pc++; $points[1] = $val;        # Y1
 259         } elsif ($key eq 30) { $pc++; $points[2] = $val;        # Z1
 260
 261         } elsif ($key eq 11) { $pc++; $points[3] = $val;        # X2
 262         } elsif ($key eq 21) { $pc++; $points[4] = $val;        # Y2
 263         } elsif ($key eq 31) { $pc++; $points[5] = $val;        # Z2
 264
 265         } elsif ($key eq 12) { $pc++; $points[6] = $val;        # X3
 266         } elsif ($key eq 22) { $pc++; $points[7] = $val;        # Y3
 267         } elsif ($key eq 32) { $pc++; $points[8] = $val;        # Z3
 268
 269         } elsif ($key eq 13) { $pc++; $points[9]  = $val;       # X4
 270         } elsif ($key eq 23) { $pc++; $points[10] = $val;       # Y4
 271         } elsif ($key eq 33) { $pc++; $points[11] = $val;       # Z4
 272
 273         } elsif ($key eq 62) {                          # color number
 274         } elsif ($key eq 70) {                          # invisible edge flag
 275         } else {
 276           print STDERR "$progname: $filename: WARNING:" .
 277             " unknown $name: \"$key $val\"\n";
 278           $error_count++;
 279         }
 280       }
 281
 282       error ("got $pc points in $name") unless ($pc == 12);
 283
 284       if ($points[6] != $points[9] ||
 285           $points[7] != $points[10] ||
 286           $points[8] != $points[11]) {
 287         error ("$filename: got a quad, not a triangle\n");
 288       } else {
 289         @points = @points[0 .. 8];
 290       }
 291
 292       foreach (@points) { $_ += 0; }    # convert strings to numbers
 293
 294       $layer = '' unless $layers_p;
 295
 296       $triangles{$layer} = [] unless defined ($triangles{$layer});
 297       push @{$triangles{$layer}}, @points;
 298
 299     } elsif ($name eq 'LINE') {
 300
 301       my @points = ();
 302       my $pc = 0;
 303       my $layer = '';
 304
 305       foreach my $entry (@$entity) {
 306         my ($key, $val) = @$entry;
 307         if      ($key eq 8)  { $layer = $val;                   # layer name
 308
 309         } elsif ($key eq 10) { $pc++; $points[0] = $val;        # X1
 310         } elsif ($key eq 20) { $pc++; $points[1] = $val;        # Y1
 311         } elsif ($key eq 30) { $pc++; $points[2] = $val;        # Z1
 312
 313         } elsif ($key eq 11) { $pc++; $points[3] = $val;        # X2
 314         } elsif ($key eq 21) { $pc++; $points[4] = $val;        # Y2
 315         } elsif ($key eq 31) { $pc++; $points[5] = $val;        # Z2
 316
 317         } elsif ($key eq 39) {                          # thickness
 318         } elsif ($key eq 62) {                          # color number
 319         } else {
 320           print STDERR "$progname: $filename: WARNING:" .
 321             " unknown $name: \"$key $val\"\n";
 322           $error_count++;
 323         }
 324       }
 325
 326       error ("got $pc points in $name") unless ($pc == 6);
 327
 328       foreach (@points) { $_ += 0; }    # convert strings to numbers
 329
 330       $layer = '' unless $layers_p;
 331
 332       $lines{$layer} = [] unless defined ($lines{$layer});
 333       push @{$lines{$layer}}, @points;
 334
 335     } elsif ($name =~ m/^\d+$/s) {
 336       error ("sequence lost: \"$code $name\"");
 337
 338     } else {
 339       print STDERR "$progname: $filename: WARNING: unknown: \"$code $name\"\n";
 340       $error_count++;
 341     }
 342
 343     error ("too many errors: bailing!") if ($error_count > 50);
 344   }
 345
 346   if ($wireframe_p) {
 347
 348     # Convert faces to lines.
 349     # Don't duplicate shared edges.
 350
 351     foreach my $layer (keys %triangles) {
 352       my %dups;
 353       my @triangles = @{$triangles{$layer}};
 354       while (@triangles) {
 355         my $x1 = shift @triangles; # 0
 356         my $y1 = shift @triangles; # 1
 357         my $z1 = shift @triangles; # 2
 358         my $x2 = shift @triangles; # 3
 359         my $y2 = shift @triangles; # 4
 360         my $z2 = shift @triangles; # 5
 361         my $x3 = shift @triangles; # 6
 362         my $y3 = shift @triangles; # 7
 363         my $z3 = shift @triangles; # 8
 364
 365         my $p = sub(@) {
 366           my ($x1, $y1, $z1, $x2, $y2, $z2) = @_;
 367           my $key1 = "$x1, $y1, $z1, $x2, $y2, $z2";
 368           my $key2 = "$x2, $y2, $z2, $x1, $y1, $z1";
 369           my $dup = $dups{$key1} || $dups{$key2};
 370           $dups{$key1} = 1;
 371           $dups{$key2} = 1;
 372           push @{$lines{$layer}}, @_ unless $dup;
 373         }
 374         ;
 375         $p->($x1, $y1, $z1, $x2, $y2, $z2);
 376         $p->($x2, $y2, $z2, $x3, $y3, $z3);
 377         $p->($x3, $y3, $z3, $x1, $y1, $z1);
 378       }
 379
 380       @{$triangles{$layer}} = ();
 381     }
 382
 383   } else {
 384     foreach my $layer (keys %lines) {
 385       my $n = @{$lines{$layer}};
 386       @{$lines{$layer}} = ();
 387       print STDERR "$progname: $filename: $layer: WARNING:" .
 388                    " ignored $n stray LINE" . ($n == 1 ? "" : "s") . ".\n"
 389        if ($n);
 390     }
 391   }
 392
 393
 394   # find bounding box, and normalize
 395   #
 396   if ($normalize_p || $verbose) {
 397     my $minx =  999999999;
 398     my $miny =  999999999;
 399     my $minz =  999999999;
 400     my $maxx = -999999999;
 401     my $maxy = -999999999;
 402     my $maxz = -999999999;
 403     my $i = 0;
 404
 405     foreach my $layer (keys %triangles) {
 406       my %dups;
 407       my @triangles = @{$triangles{$layer}};
 408
 409       foreach my $n (@{$lines{$layer}}, @{$triangles{$layer}}) {
 410         if    ($i == 0) { $minx = $n if ($n < $minx);
 411                           $maxx = $n if ($n > $maxx); }
 412         elsif ($i == 1) { $miny = $n if ($n < $miny);
 413                           $maxy = $n if ($n > $maxy); }
 414         else            { $minz = $n if ($n < $minz);
 415                           $maxz = $n if ($n > $maxz); }
 416         $i = 0 if (++$i == 3);
 417       }
 418     }
 419
 420     my $w = ($maxx - $minx);
 421     my $h = ($maxy - $miny);
 422     my $d = ($maxz - $minz);
 423     my $sizea = ($w > $h ? $w : $h);
 424     my $sizeb = ($w > $d ? $w : $d);
 425     my $size = ($sizea > $sizeb ? $sizea : $sizeb);
 426
 427     print STDERR "$progname: $filename: bbox is " .
 428                   sprintf("%.2f x %.2f x %.2f\n", $w, $h, $d)
 429        if ($verbose);
 430     print STDERR "$progname: $filename: center is " .
 431                   sprintf("%.2f, %.2f, %.2f\n",
 432                           $minx + $w / 2,
 433                           $miny + $h / 2,
 434                           $minz + $d / 2)
 435        if ($verbose);
 436
 437     if ($normalize_p) {
 438       $w /= $size;
 439       $h /= $size;
 440       $d /= $size;
 441
 442       print STDERR "$progname: $filename: dividing by " .
 443                    sprintf("%.2f", $size) . " for bbox of " .
 444                    sprintf("%.2f x %.2f x %.2f\n", $w, $h, $d)
 445         if ($verbose);
 446       foreach my $layer (keys %triangles) {
 447         foreach my $n (@{$triangles{$layer}}) { $n /= $size; }
 448         foreach my $n (@{$lines{$layer}})     { $n /= $size; }
 449       }
 450     }
 451   }
 452
 453   return ($wireframe_p ? \%lines : \%triangles);
 454 }
 455
 456
 457 sub generate_c_1($$$$$@) {
 458   my ($name, $outfile, $smooth_p, $wireframe_p, $normalize_p, @points) = @_;
 459
 460   my $ccw_p = 1;  # counter-clockwise winding rule for computing normals
 461
 462   my $npoints = ($#points + 1) / 3;
 463   my $nfaces = ($wireframe_p ? $npoints/2 : $npoints/3);
 464
 465   my @normals;
 466   if ($smooth_p && !$wireframe_p) {
 467     @normals = compute_vertex_normals (@points);
 468
 469     if ($#normals != $#points) {
 470       error ("computed " . (($#normals+1)/3) . " normals for " .
 471              (($#points+1)/3) . " points?");
 472     }
 473   }
 474
 475   my $code .= "\nstatic const float ${name}_data[] = {\n";
 476
 477   if ($wireframe_p) {
 478     my %dups;
 479     for (my $i = 0; $i < $nfaces; $i++) {
 480       my $ax = $points[$i*6];
 481       my $ay = $points[$i*6+1];
 482       my $az = $points[$i*6+2];
 483
 484       my $bx = $points[$i*6+3];
 485       my $by = $points[$i*6+4];
 486       my $bz = $points[$i*6+5];
 487
 488       my $lines = sprintf("\t" . "%.6f,%.6f,%.6f,\n" .
 489                           "\t" . "%.6f,%.6f,%.6f,\n",
 490                           $ax, $ay, $az,
 491                           $bx, $by, $bz);
 492       $lines =~ s/([.\d])0+,/$1,/g;  # lose trailing insignificant zeroes
 493       $lines =~ s/\.,/,/g;
 494       $lines =~ s/-0,/0,/g;
 495
 496       $code .= $lines;
 497     }
 498
 499   } else {
 500     for (my $i = 0; $i < $nfaces; $i++) {
 501       my $ax = $points[$i*9];
 502       my $ay = $points[$i*9+1];
 503       my $az = $points[$i*9+2];
 504
 505       my $bx = $points[$i*9+3];
 506       my $by = $points[$i*9+4];
 507       my $bz = $points[$i*9+5];
 508
 509       my $cx = $points[$i*9+6];
 510       my $cy = $points[$i*9+7];
 511       my $cz = $points[$i*9+8];
 512
 513       my ($nax, $nay, $naz,
 514           $nbx, $nby, $nbz,
 515           $ncx, $ncy, $ncz);
 516
 517       if ($smooth_p) {
 518         $nax = $normals[$i*9];
 519         $nay = $normals[$i*9+1];
 520         $naz = $normals[$i*9+2];
 521
 522         $nbx = $normals[$i*9+3];
 523         $nby = $normals[$i*9+4];
 524         $nbz = $normals[$i*9+5];
 525
 526         $ncx = $normals[$i*9+6];
 527         $ncy = $normals[$i*9+7];
 528         $ncz = $normals[$i*9+8];
 529
 530       } else {
 531         if ($ccw_p) {
 532           ($nax, $nay, $naz) = face_normal ($ax, $ay, $az,
 533                                             $bx, $by, $bz,
 534                                             $cx, $cy, $cz);
 535         } else {
 536           ($nax, $nay, $naz) = face_normal ($ax, $ay, $az,
 537                                             $cx, $cy, $cz,
 538                                             $bx, $by, $bz);
 539         }
 540         ($nbx, $nby, $nbz) = ($nax, $nay, $naz);
 541         ($ncx, $ncy, $ncz) = ($nax, $nay, $naz);
 542       }
 543
 544       my $lines = sprintf("\t" . "%.6f,%.6f,%.6f," . "%.6f,%.6f,%.6f,\n" .
 545                           "\t" . "%.6f,%.6f,%.6f," . "%.6f,%.6f,%.6f,\n" .
 546                           "\t" . "%.6f,%.6f,%.6f," . "%.6f,%.6f,%.6f,\n",
 547                           $nax, $nay, $naz,  $ax, $ay, $az,
 548                           $nbx, $nby, $nbz,  $bx, $by, $bz,
 549                           $ncx, $ncy, $ncz,  $cx, $cy, $cz);
 550       $lines =~ s/([.\d])0+,/$1,/g;  # lose trailing insignificant zeroes
 551       $lines =~ s/\.,/,/g;
 552       $lines =~ s/-0,/0,/g;
 553
 554       $code .= $lines;
 555     }
 556   }
 557
 558   my $format    = ($wireframe_p ? 'GL_V3F'   : 'GL_N3F_V3F');
 559   my $primitive = ($wireframe_p ? 'GL_LINES' : 'GL_TRIANGLES');
 560
 561   $code =~ s/,\n$//s;
 562   $code .= "\n};\n";
 563   $code .= "static const struct gllist ${name}_frame = {\n";
 564   $code .= " $format, $primitive, $npoints, ${name}_data, 0\n};\n";
 565   $code .= "const struct gllist *$name = &${name}_frame;\n";
 566
 567   print STDERR "$progname: $outfile: $name: $npoints points, $nfaces faces.\n"
 568     if ($verbose);
 569
 570   return ($code, $npoints, $nfaces);
 571 }
 572
 573
 574 sub generate_c($$$$$$) {
 575   my ($infile, $outfile, $smooth_p, $wireframe_p, $normalize_p, $layers) = @_;
 576
 577   my $code = '';
 578
 579   my $token = $outfile;    # guess at a C token from the filename
 580   $token =~ s/\<[^<>]*\>//;
 581   $token =~ s@^.*/@@;
 582   $token =~ s/\.[^.]*$//;
 583   $token =~ s/[^a-z\d]/_/gi;
 584   $token =~ s/__+/_/g;
 585   $token =~ s/^_//g;
 586   $token =~ s/_$//g;
 587   $token =~ tr [A-Z] [a-z];
 588   $token = 'foo' if ($token eq '');
 589
 590   my @layers = sort (keys %$layers);
 591
 592   $infile =~ s@^.*/@@s;
 593   $code .= ("/* Generated from \"$infile\" on " .
 594             strftime ("%d-%b-%Y", localtime ()) . ".\n" .
 595             "   " . ($wireframe_p
 596                      ? "Wireframe."
 597                      : ($smooth_p ?
 598                         "Smoothed vertex normals." :
 599                         "Faceted face normals.")) .
 600             ($normalize_p ? " Normalized to unit bounding box." : "") .
 601             "\n" .
 602             (@layers > 1
 603              ? wrap ("   ", "     ", "Components: " . join (", ", @layers)) . ".\n"
 604              : "") .
 605             " */\n\n");
 606
 607   $code .= "#include \"gllist.h\"\n";
 608
 609   my $npoints = 0;
 610   my $nfaces = 0;
 611
 612   foreach my $layer (@layers) {
 613     my $name = $layer ? "${token}_${layer}" : $token;
 614     my ($c, $np, $nf) =
 615       generate_c_1 ($name, $outfile,
 616                     $smooth_p, $wireframe_p, $normalize_p,
 617                     @{$layers->{$layer}});
 618     $code .= $c;
 619     $npoints += $np;
 620     $nfaces  += $nf;
 621   }
 622
 623   print STDERR "$progname: $outfile: total: $npoints points, $nfaces faces.\n"
 624     if ($verbose && @layers > 1);
 625
 626   return $code;
 627 }
 628
 629
 630 # Returns true if the two files differ (by running "cmp")
 631 #
 632 sub cmp_files($$) {
 633   my ($file1, $file2) = @_;
 634
 635   my @cmd = ("cmp", "-s", "$file1", "$file2");
 636   print STDERR "$progname: executing \"" . join(" ", @cmd) . "\"\n"
 637     if ($verbose > 3);
 638
 639   system (@cmd);
 640   my $exit_value  = $? >> 8;
 641   my $signal_num  = $? & 127;
 642   my $dumped_core = $? & 128;
 643
 644   error ("$cmd[0]: core dumped!") if ($dumped_core);
 645   error ("$cmd[0]: signal $signal_num!") if ($signal_num);
 646   return $exit_value;
 647 }
 648
 649
 650 sub dxf_to_gl($$$$$$) {
 651   my ($infile, $outfile, $smooth_p, $normalize_p, $wireframe_p, $layers_p) = @_;
 652
 653   open (my $in, "<$infile") || error ("$infile: $!");
 654   my $filename = ($infile eq '-' ? "<stdin>" : $infile);
 655   print STDERR "$progname: reading $filename...\n"
 656     if ($verbose);
 657
 658   local $/ = undef;  # read entire file
 659   my $dxf = <$in>;
 660   close $in;
 661
 662   my $data = parse_dxf ($filename, $dxf, $normalize_p, $wireframe_p, $layers_p);
 663
 664   $filename = ($outfile eq '-' ? "<stdout>" : $outfile);
 665   my $code = generate_c ($infile, $filename, $smooth_p, $wireframe_p,
 666                          $normalize_p, $data);
 667
 668   if ($outfile eq '-') {
 669     print STDOUT $code;
 670   } else {
 671     my $tmp = "$outfile.tmp";
 672     open (my $out, '>', $tmp) || error ("$tmp: $!");
 673     print $out $code || error ("$filename: $!");
 674     close $out || error ("$filename: $!");
 675     if (cmp_files ($filename, $tmp)) {
 676       if (!rename ($tmp, $filename)) {
 677         unlink $tmp;
 678         error ("mv $tmp $filename: $!");
 679       }
 680       print STDERR "$progname: wrote $filename\n";
 681     } else {
 682       unlink "$tmp" || error ("rm $tmp: $!\n");
 683       print STDERR "$progname: $filename unchanged\n" if ($verbose);
 684     }
 685   }
 686 }
 687
 688
 689 sub error() {
 690   ($_) = @_;
 691   print STDERR "$progname: $_\n";
 692   exit 1;
 693 }
 694
 695 sub usage() {
 696   print STDERR "usage: $progname " .
 697         "[--verbose] [--normalize] [--smooth] [--wireframe] [--layers]\n" .
 698         "[infile [outfile]]\n";
 699   exit 1;
 700 }
 701
 702 sub main() {
 703   my ($infile, $outfile);
 704   my $normalize_p = 0;
 705   my $smooth_p = 0;
 706   my $wireframe_p = 0;
 707   my $layers_p = 0;
 708   while ($_ = $ARGV[0]) {
 709     shift @ARGV;
 710     if ($_ eq "--verbose") { $verbose++; }
 711     elsif (m/^-v+$/) { $verbose += length($_)-1; }
 712     elsif ($_ eq "--normalize") { $normalize_p = 1; }
 713     elsif ($_ eq "--smooth") { $smooth_p = 1; }
 714     elsif ($_ eq "--wireframe") { $wireframe_p = 1; }
 715     elsif ($_ eq "--layers") { $layers_p = 1; }
 716     elsif (m/^-./) { usage; }
 717     elsif (!defined($infile)) { $infile = $_; }
 718     elsif (!defined($outfile)) { $outfile = $_; }
 719     else { usage; }
 720   }
 721
 722   $infile  = "-" unless defined ($infile);
 723   $outfile = "-" unless defined ($outfile);
 724
 725   dxf_to_gl ($infile, $outfile, $smooth_p, $normalize_p, $wireframe_p, $layers_p);
 726 }
 727
 728 main;
 729 exit 0;