7 Carp::cluck "Exception: $@";
10 # ent file managing tool
14 # perl entmerge.pl $scalefactor < mapname.map > mapname.ent
17 # perl entmerge.pl $scalefactor mapname.ent < mapname.map > mapname-merged.map
20 # perl bsptool.pl mapname.bsp -xentities > mapname.ent
23 # perl bsptool.pl mapname.bsp -rentities < mapname.ent
28 return $a->[0]*$b->[0]
37 $a->[1]*$b->[2] - $a->[2]*$b->[1],
38 $a->[2]*$b->[0] - $a->[0]*$b->[2],
39 $a->[0]*$b->[1] - $a->[1]*$b->[0]
50 $c += $data[2*$_ + 0] * $data[2*$_ + 1]->[$coord]
60 return DotProduct $v, $v;
66 return sqrt VectorLength2 $v;
69 sub VectorNormalize($)
72 return VectorMAM 1/VectorLength($v), $v;
75 sub Polygon_QuadForPlane($$)
77 my ($plane, $quadsize) = @_;
80 if(abs($plane->[2]) > abs($plane->[0]) && abs($plane->[2]) > abs($plane->[1]))
89 $quadup = VectorMAM 1, $quadup, -DotProduct($quadup, $plane), $plane;
90 $quadup = VectorMAM $plane->[3], VectorNormalize $quadup;
92 my $quadright = CrossProduct $quadup, $plane;
95 VectorMAM($plane->[3], $plane, -$quadsize*2, $quadright, +$quadsize*2, $quadup),
96 VectorMAM($plane->[3], $plane, +$quadsize*2, $quadright, +$quadsize*2, $quadup),
97 VectorMAM($plane->[3], $plane, +$quadsize*2, $quadright, -$quadsize*2, $quadup),
98 VectorMAM($plane->[3], $plane, -$quadsize*2, $quadright, -$quadsize*2, $quadup)
102 sub Polygon_Clip($$$)
104 my ($points, $plane, $epsilon) = @_;
112 my $ndist = DotProduct($points->[$n], $plane) - $plane->[3];
114 my @outfrontpoints = ();
116 for my $i(0..@$points - 1)
120 $n = ($i+1) % @$points;
121 $ndist = DotProduct($points->[$n], $plane) - $plane->[3];
122 if($pdist >= -$epsilon)
124 push @outfrontpoints, $points->[$p];
126 if(($pdist > $epsilon && $ndist < -$epsilon) || ($pdist < -$epsilon && $ndist > $epsilon))
128 my $frac = $pdist / ($pdist - $ndist);
129 push @outfrontpoints, VectorMAM 1-$frac, $points->[$p], $frac, $points->[$n];
133 return \@outfrontpoints;
138 my ($p, $q, $r) = @_;
140 my $a = VectorMAM 1, $q, -1, $p;
141 my $b = VectorMAM 1, $r, -1, $p;
142 my $n = VectorNormalize CrossProduct $a, $b;
144 return [ @$n, DotProduct $n, $p ];
147 sub GetBrushWindings($)
153 for my $i(0..(@$planes - 1))
155 my $winding = Polygon_QuadForPlane $planes->[$i], 65536;
157 for my $j(0..(@$planes - 1))
161 $winding = Polygon_Clip $winding, $planes->[$j], 1/64.0;
164 push @windings, $winding
165 unless @$winding == 0;
171 sub GetBrushMinMax($)
175 if($brush->[0] =~ /^\(/)
181 /^\(\s+(\S+)\s+(\S+)\s+(\S+)\s+\)\s+\(\s+(\S+)\s+(\S+)\s+(\S+)\s+\)\s+\(\s+(\S+)\s+(\S+)\s+(\S+)\s+\)\s+/
182 or die "Invalid line in plain brush: $_";
183 push @planes, MakePlane [ $1, $2, $3 ], [ $4, $5, $6 ], [ $7, $8, $9 ];
184 # for any three planes, find their intersection
185 # check if the intersection is inside all other planes
188 my $windings = GetBrushWindings \@planes;
200 $mins[$_] = $v->[$_] if $mins[$_] > $v->[$_];
201 $maxs[$_] = $v->[$_] if $maxs[$_] < $v->[$_];
214 return \@mins, \@maxs;
217 die "Cannot decode this brush yet! brush is @$brush";
226 for my $brush(@$brushes)
232 if /\bcommon\/origin\b/;
236 my ($mins, $maxs) = GetBrushMinMax $brush;
237 @org = map { 0.5 * ($mins->[$_] + $maxs->[$_]) } 0..2
256 chomp; s/\r//g; s/\0//g; s/\/\/.*$//; s/^\s+//; s/\s+$//; next if /^$/;
263 chomp; s/\r//g; s/\0//g; s/\/\/.*$//; s/^\s+//; s/\s+$//; next if /^$/;
265 if(/^"(.*?)" "(.*)"$/)
273 push @brushes, $brush;
277 chomp; s/\r//g; s/\0//g; s/\/\/.*$//; s/^\s+//; s/\s+$//; next if /^$/;
286 chomp; s/\r//g; s/\0//g; s/\/\/.*$//; s/^\s+//; s/\s+$//; next if /^$/;
313 return \%ent, \@brushes;
319 die "Unexpected line in top level: >>$_<<";
326 sub UnparseEntity($$)
328 my ($ent, $brushes) = @_;
335 $s .= "\"$_\" \"$ent{$_}\"\n";
343 $s .= "$_\n" for @$_;
352 my ($scale, $in_ent) = @ARGV;
355 if not defined $scale;
359 my @entities_skipped = ();
361 # THIS part is always a .map file
366 my ($ent, $brushes) = ParseEntity \*STDIN;
371 if($first && $ent->{classname} eq 'worldspawn')
373 $keeplights = $ent->{_keeplights};
374 delete $ent->{_keeplights};
375 @submodels = ($brushes);
381 push @entities, { classname => "worldspawn" };
385 if($ent->{classname} eq 'worldspawn')
387 $ent->{classname} = "worldspawn_renamed";
390 if(grep { $_ eq $ent->{classname} } qw/group_info func_group misc_model _decal _skybox/)
392 push @entities_skipped, [$ent, $brushes];
396 if(!$keeplights && $ent->{classname} =~ /^light/)
398 push @entities_skipped, [$ent, $brushes];
405 push @submodels, $brushes;
406 $ent->{model} = sprintf "*%d", $i;
410 push @entities, $ent;
417 push @entities, { classname => "worldspawn" };
423 # translate map using ent to map
424 open my $fh, "<", $in_ent
425 or die "$in_ent: $!";
427 # THIS part is always an .ent file now
428 my @entities_entfile = ();
431 my $clear_all_worldlights;
435 my ($ent, $brushes) = ParseEntity $fh;
440 if($first && $ent->{classname} eq 'worldspawn')
447 push @entities_entfile, { classname => "worldspawn" };
450 if($ent->{classname} eq 'worldspawn')
452 $ent->{classname} = "worldspawn_renamed";
455 if(!$keeplights && $ent->{classname} =~ /^light/)
457 # light entity detected!
458 # so let's replace all light entities
459 $clear_all_worldlights = 1;
463 if(defined $ent->{model} and $ent->{model} =~ /^\*(\d+)$/)
465 my $entfileorigin = [ split /\s+/, ($ent->{origin} || "0 0 0") ];
466 my $baseorigin = BrushOrigin $submodels[$1];
468 if(defined $baseorigin)
470 my $org = VectorMAM 1, $entfileorigin, -1, $baseorigin;
471 $ent->{origin} = sprintf "%.6f %.6f %.6f", @$org;
475 push @entities_entfile, $ent;
480 if($keeplights && !$entities_entfile[0]->{keeplights})
483 # the .ent file was made without keeplights
484 # merging it with the .map would delete all lights
485 # so insert all light entities here!
486 @entities_skipped = (@entities_skipped,
489 my $submodel = undef;
490 if(defined $_->{model} and $_->{model} =~ /^\*(\d+)$/)
492 $submodel = $submodels[$1];
498 $_->{classname} =~ /^light/
504 if($clear_all_worldlights)
507 # the .ent file was made with keeplights
508 # the .map did not indicate so!
509 # so we must delete all lights from the skipped entity list
510 @entities_skipped = grep { $_->[0]->{classname} !~ /^light/ } @entities_skipped;
515 push @entities_entfile, { classname => "worldspawn" };
519 for(@entities_entfile)
522 my $submodel = undef;
524 $e{gridsize} = "64 64 128" if not exists $e{gridsize} and $first;
525 $e{lip} /= $scale if exists $e{lip};
526 $e{origin} = sprintf '%.6f %.6f %.6f', map { $_ / $scale } split /\s+/, $e{origin} if exists $e{origin};
527 $e{gridsize} = sprintf '%.6f %.6f %.6f', map { $_ / $scale } split /\s+/, $e{gridsize} if exists $e{gridsize} and $first;
531 $submodel = $submodels[0];
538 delete $e{_keeplights};
541 elsif(defined $e{model} and $e{model} =~ /^\*(\d+)$/)
543 $submodel = $submodels[$1];
546 print UnparseEntity \%e, $submodel;
549 for(@entities_skipped)
551 print UnparseEntity $_->[0], $_->[1];
557 # translate map to ent
571 delete $e{_keeplights};
575 if(defined $e{model} and $e{model} =~ /^\*(\d+)$/)
577 my $oldorigin = [ split /\s+/, ($e{origin} || "0 0 0") ];
578 my $org = BrushOrigin $submodels[$1];
582 $org = VectorMAM 1, $org, 1, $oldorigin;
583 $e{origin} = sprintf "%.6f %.6f %.6f", @$org;
587 $e{gridsize} = "64 64 128" if not exists $e{gridsize} and $first;
588 $e{lip} *= $scale if exists $e{lip};
589 $e{origin} = sprintf '%.6f %.6f %.6f', map { $_ * $scale } split /\s+/, $e{origin} if exists $e{origin};
590 $e{gridsize} = sprintf '%.6f %.6f %.6f', map { $_ * $scale } split /\s+/, $e{gridsize} if exists $e{gridsize} and $first;
592 print UnparseEntity \%e, undef;