doomtrut.pl

Post date: May 21, 2010 5:56:45 PM

A script for knowing which textures are unused on a wad file, so you can reduce the filesize of your wad file.

Does not work perfectly, but with the output of this program plus the Texture and Patch editor from Deepsea, was very easy to remove the unused textures AND patches.

* Right now, the program ignores:

Animated textures and switches.

* If you dont have an ANIMATED or SWITCHES lump in your wad, you may have problems with the animated and switches textures in your wad. You may want to be careful with that. This is a part of the program that needs work.

* Also, pid_changes.txt is not exact, so ignore it by now. Is not really needed anyway (if you use deepsea to delete the unused data).

* You may want to be careful also with SKY1, SKY2 and SKY3 textures.

Save the code as doomtrut.pl, and,

if you have perl installed, you can run the program like this

> perl doomtrut.pl

PS:

Recommendation:

With DeepSea, remove first the unused textures, and the patches later.

#!perl -w

#

# ________________

# / /

# | doomtrut.pl | DOOM Tool for Removing Unused Textures

# /_______________/ Version 0.1

#

# The original source file was obtained from the wad2svg perl script, by Collin Phipps.

# Well, only 3 functions are his, but the most important ones anyway:

# read_lump read_objects open_wad

# This was WAD.pm, modified by [shin] to obtain names of unused textures

# and lumps. I seek no optimizations or elegance, just get the work done.

#

# You can modify this file, but if you plan to release the modifications, please send me a mail.

# I want to be involved if possible in future improvements of this script. I only ask 1 thing...

# !!!!!!!! KEEP ALL THE PROGRAM IN ONE FILE !!!!!!

# ==== Also, questions I will NOT answer ====

# Q1: Why not C/C++?

# Q2: How do i run it?

#

# LIST OF CONTRIBUTORS: Please, put your initials when commenting the code, if its relevant, of course.

# shinobi.cl -> [shin]

use strict;

my (

%lumps, #This hash contains all the wad file. [shin]

$n_lumps, #Number of lumps [shin]

%PNAMES, #Hash {PINDEX}, with references to a special structure which has a NAME, and a USED flag (only 0 or 1)

%TEXTURES, # Hash{NAME} with references to a special structure which has a USE_COUNT and an array PATCHES of pnames index references

@SIDEDEFS, #contains only a texture name.

@ANIMATED, @SWITCHES, # These textures should be ignored or carefully checked.For now, they will be ignored (i.e. always will report as a USED TEXTURE)

@P_ORDER, @T_ORDER, # To keep the original order of the resources.

$n_pnames

);

sub trim {

return unless my $string = shift;

$string =~ s/^\s+//;

$string =~ s/\s+$//;

return $string;

};

# The 2 following functions were originally written by Colin Phipps.

# Of course, these have some little modifications by me [shin]

sub open_wad {

my $filename = shift;

open (WAD, $filename) or die "Failed to open: $!";

my $header;

read (WAD, $header, 12) == 12 or die "Failed to read header: $!";

my ($sig, $lumps, $diroff) = unpack ("a4VV", $header);

seek WAD, $diroff, 0 or die "Could not seek to directory: $!";

my $curlevel;

my $num_lumps = $lumps;

while ($lumps--) {

my $dirent;

read (WAD, $dirent, 16) == 16 or die "Failed to read dir entry: $!";

my ($pos, $size) = unpack ("VV", $dirent);

my $name = substr $dirent, 8; $name =~ s/\0.*//;

#We are only interested on this case in sidedefs only, but you can 'or' more types. This was the original line ---> if ($name =~ /^(?:THINGS|VERTEXES|LINEDEFS|SIDEDEFS|SECTORS|SSECTORS|SEGS|NODES|BLOCKMAP|REJECT)$/) {

if ($name =~ /^(?:SIDEDEFS)$/) {

$name = "$curlevel/$name";

} elsif ($name =~ /^(?:MAP\d\d|E\dM\d)$/) {

$curlevel = $name;

}

$lumps{$name} = [ $pos, $size ];

}

return $num_lumps;

}

sub read_lump {

my $lump = shift or die "Must give lump name";

$lump = $lumps{$lump} or return undef;;

seek WAD, $lump->[0],0 or return undef;

my $data;

read (WAD, $data, $lump->[1]) == $lump->[1] or return undef;

return $data;

}

# We need 4 parsers, for TEXTUREn, SIDEDEFS, ANIMDEFS and PNAMES

sub parse_pnames {

my (@data, $p_index);

my $content = read_lump('PNAMES');

die "This wad does not include PNAMES....Don't waste my time." if (!defined $content);

$n_pnames = (length($content)-4)/8;

print "Found ".$n_pnames." PNAMES entrys.".$/;

#Now, each PNAME is fixed at 8 characters, so, we begin extracting

#The '+4' is because the 1st 4 symbols are not part of any patch name [shin]

foreach $p_index (0..$n_pnames-1) {

my $patch_info = {

name => substr($content, (8*($p_index) +4), 8),

used => 0

};

$PNAMES{($p_index)} = \$patch_info;

push @P_ORDER, $p_index;

};

return $n_pnames;

}

sub parse_textures {

my (

$content, $n_textures, $index, @texture_offsets,

$start, $offset, $info_size, $info_start, $info_pointer,

@patch_info, @patch_number, $n_patches, $p_index

);

my @TEXT_lumps = ('TEXTURE1', 'TEXTURE2');

foreach (@TEXT_lumps) {

$content = read_lump $_;

next if (!defined $content);

#So, now we have the info about the textures

#To know how many textures are defined, we read the 1st 4 bytes (or 32 bytes)

my $header = substr($content, 0, 4);

$n_textures = unpack ('V', $header); #Read the 4 first bytes and interpret it as texture count

print "There is ".$n_textures.$/." textures in ".$_.".".$/;

#Now, we need a array for getting the offsets for each texture

foreach $index (1..$n_textures) {

push @texture_offsets, unpack('V', substr($content, ($index * 4) -1, 4));

}

#The textures offset represents bytes in the TEXTUREn lump

#So, we know where to look for those textures

$start = shift @texture_offsets;

$info_start = 4 + (4 * $n_textures);

$content = substr($content, $info_start);

$info_start = 0;

my @data_bytes = unpack ("C*", $content); #We need Unsigned numbers![shin]

$index = 0;

foreach $offset (@texture_offsets) {

$info_size = $offset - $start;

$n_patches = ($info_size - 5632)/2560;

# Based on info_size, we can know how many patches are.

# 8192 = 1, 10752 = 2, 13312 = 3, 15872 = 4, 18432 = 5, etc

$start = $offset;

my @texture_name = @data_bytes[$info_start..$info_start + 7]; # 8 bytes

# After that data, we must continue with the patches until we reach $info_start + $info_size [shin]

$info_pointer = $info_start + 20;

my @pindex_list = ();

foreach $p_index (1..$n_patches) {

@patch_info = @data_bytes[$info_pointer..$info_pointer+11];

# We must recalculate the patch number based on 2 bytes, as an integer

# So we convert first to binary and add the strings,

# and later converting it to an integer [shin]

my $pid = unpack("B8", pack("C", $patch_info[7])).unpack("B8", pack("C", $patch_info[6]));

$pid =~ s/^0+//; #We took the starting zeroes from the binary number

#Finally, we got the patch number. I took this line directly from an "perl recipe". May need a little retouch, but right now just works ok. [shin]

$pid = unpack("N", pack("B32", substr("0" x 32 . $pid, -32)));

#We put the patch index in an array, only if does not exist beforehand

my $pid_exists = 0;

foreach (@pindex_list) { $pid_exists = 1 if ($_ == $pid); };

push @pindex_list, $pid if (!$pid_exists);

##print "#".$pid.$/;

# We jump 10 bytes for each patch record, 12 bytes for the last one.[shin]

$info_pointer += ($p_index != $n_patches)?10:12;

}

$info_start = $info_pointer;

#We create a special structure and link it to the TEXTURES hash

my $t_name = "";

$t_name .= chr($_) foreach (@texture_name);

my %texture_info = (

name => $t_name,

use_count => 0,

patches => [@pindex_list]

);

$TEXTURES{$t_name} = \%texture_info;

push @T_ORDER, $t_name;

}

}

}

sub parse_sidedefs {

my ($content, $info_start, $keep_reading, $p_index, $s_index, $n_sidedefs);

$keep_reading = 1;

for my $key ( keys %lumps ) {

if ( ($key =~ m/MAP\d\d\/SIDEDEFS/) || ($key =~ m/E\dM\d\/SIDEDEFS/) ) {

#We have found a sidedef lump. Now, to extract the info on it. [shin]

my $content = read_lump($key);

print $/."ANALYZING SIDEDEFS FROM ".$key."****".$/;

my @data_bytes = unpack("C*", $content);

$n_sidedefs = ($#data_bytes+1)/30;

$info_start = 0;

my (@x_offset, @y_offset, @upper_texture, @lower_texture, @middle_texture, $ut_name, $lt_name, $mt_name);

foreach $s_index (1..$n_sidedefs) {

@x_offset = @data_bytes[$info_start..$info_start + 1];

@y_offset = @data_bytes[$info_start + 2..$info_start + 3];

@upper_texture = @data_bytes[$info_start + 4..$info_start + 11];

@lower_texture = @data_bytes[$info_start + 12..$info_start + 19];

@middle_texture = @data_bytes[$info_start + 20..$info_start + 27];

$ut_name = ''; $lt_name = ''; $mt_name = '';

$ut_name .= chr($_) foreach (@upper_texture);

$lt_name .= chr($_) foreach (@lower_texture);

$mt_name .= chr($_) foreach (@middle_texture);

#print ".";

#Now that we have the names for the textures on the sidedef, we update the use count for that

#texture[shin]

$TEXTURES{$ut_name}->{use_count} += 1;

$TEXTURES{$lt_name}->{use_count} += 1;

$TEXTURES{$mt_name}->{use_count} += 1;

#Do the same for the patches in the textures

my $ref_patch; my $patch_name;

print "------------------".$/.$ut_name.": ";

foreach (@{$TEXTURES{$ut_name}->{patches}}) {

$patch_name = $P_ORDER[$_];

$ref_patch = $PNAMES{$_};

$$ref_patch->{used} = 1;

print " $_=".($patch_name);

#print " $_=".($$ref_patch->{name});

};

print $/.$lt_name.": ";

foreach (@{$TEXTURES{$lt_name}->{patches}}) {

$ref_patch = $PNAMES{$_};

$$ref_patch->{used} = 1;

print " $_=".($$ref_patch->{name});

};

print $/.$mt_name.": ";

foreach (@{$TEXTURES{$mt_name}->{patches}}) {

$ref_patch = $PNAMES{$_};

$$ref_patch->{used} = 1;

print " $_=".($$ref_patch->{name});

};

$info_start += 30; #Each sidedef record has 30 bytes

print $/;

}

print $/;

}

}

};

sub parse_animated {

my ($info_start);

my $content = read_lump('ANIMATED');

return if !defined $content;

my @data_bytes = unpack ('C*', $content);

my $keep_reading = 1;

$info_start = 0;

while ($keep_reading) {

my $mark = $data_bytes[$info_start];

if ($mark != 255) {

if ($mark == 1) { #0 is ignored, as represents a flat, which are unsupported by this program [shin]

my ($start_texture, $finish_texture);

$finish_texture .= chr($_) foreach (@data_bytes[$info_start + 1..$info_start + 8]);

$start_texture .= chr($_) foreach (@data_bytes[$info_start + 10..$info_start + 17]);

my $start = 0;

foreach (@T_ORDER) {

if ($start == 0) {

if ($_ eq $start_texture) {

$start = 1;

push (@ANIMATED, $_);

print ".";

}

} else {

if ($_ ne $finish_texture) {

push (@ANIMATED, $_);

print ".";

} else {

push (@ANIMATED, $_);

print ".";

last;

}

}

}

}

} else {

#255 marks the end of the animated lump

$keep_reading = 0;

}

$info_start += 23;

}

}

sub parse_switches {

my $info_start;

my $content = read_lump('SWITCHES');

return if !defined $content;

my @data_bytes = unpack ('C*', $content);

my $keep_reading = 1;

$info_start = 0;

while ($keep_reading) {

my ($off_texture, $on_texture);

$off_texture .= chr($_) foreach (@data_bytes[$info_start..$info_start + 8]);

$on_texture .= chr($_) foreach (@data_bytes[$info_start + 9..$info_start + 16]);

my $mark = $data_bytes[$info_start + 20];

if ($mark != 0) {

my $texture_name;

push @SWITCHES, $off_texture;

push @SWITCHES, $on_texture;

print "..";

} else {

#0 marks the end of the switch lump

$keep_reading = 0;

}

$info_start += 20;

}

}

sub keep_animated_and_switches {

#We make sure that animated textures and switches does appear as USED, always. [shin]

my $texture;

#We should include SKY1, SKY2, and SKY3 so they are never removed. Thats because most

#of the time they are used as floors or ceilings, and not in a sidedef.

foreach $texture (@ANIMATED) {

$TEXTURES{$texture}->{use_count} += 1;

#Do the same for the patches in the texture

foreach my $patch (@{$TEXTURES{$texture}->{patches}}) {

my $ref_patch = $PNAMES{$patch};

$$ref_patch->{used} = 1;

}

}

foreach $texture (@SWITCHES) {

$TEXTURES{$texture}->{use_count} += 1;

foreach my $patch (@{$TEXTURES{$texture}->{patches}}) {

my $ref_patch = $PNAMES{$patch};

$$ref_patch->{used} = 1;

}

}

}

sub create_results {

open UNUSED_PATCHES, "> unused_patches.txt" or die "can't write unused_patches.txt: $!";

#We print the results in the original order.

#The new pnames will be generated now.

open NEW_PNAMES, "> your_new_pnames.txt" or die "can't write your_new_pnames: $!";

print "########### Used patches ###########".$/;

my $p_index = 0;

foreach (@P_ORDER) {

my $ref_patch = $PNAMES{$_};

my $patch_name = $$ref_patch->{name};

my $patch_used = $$ref_patch->{used};

if ($patch_used == 0) {

print UNUSED_PATCHES $patch_name.$/;

delete $PNAMES{$_};

} else {

print NEW_PNAMES ($patch_name."\t".$p_index++.$/);

print "(".$patch_name.") ".$/;

}

}

close UNUSED_PATCHES; close NEW_PNAMES;

#We create a table for replacement of PIDs on the TEXTUREx lump

#We have an array with all the Patch names, this gives also the OLD index.

#And with that we look in the PATCHES hash. If it exists, we print the old and the new pindex

#to a file pid_changes.txt

print "########### PID changes ############";

open PID_CHANGES, "> pid_changes.txt" or die "can't write pid_changes.txt: $!";

$p_index = 0;

my $unused_p_index = 0;

foreach (@P_ORDER) {

if (defined $PNAMES{$p_index}) {

$p_index += 1;

print PID_CHANGES $p_index." -gone-".$/;

} else {

$p_index += 1;

$unused_p_index += 1;

print PID_CHANGES $p_index." ".$unused_p_index.$/;

}

}

close PID_CHANGES;

print "########### Used textures ###########".$/;

open UNUSED_TEXTURES, "> unused_textures.txt" or die "can't write unused_textures.txt: $!";

foreach (@T_ORDER) {

my $ref_texture = $TEXTURES{$_};

my $texture_name = $ref_texture->{name};

my $texture_used = $ref_texture->{use_count};

if ($texture_used == 0) {

print UNUSED_TEXTURES $texture_name.$/ ;

} else {

print "(".$texture_name.", used ".$texture_used." times) ".$/;

}

}

close UNUSED_TEXTURES;

}

#--------------------------------------------------------------------------#

#-----------------------| Execution starts here |--------------------------#

#--------------------------------------------------------------------------#

die "

A quick solution for a 14 year problem!!!! :)

doomtrut will do one of the hardest works in doom editing for you.

it will give you a list with all the unused textures with their patches

data in a wadfile, so you can clean it of all that unnecessary data.

use:

perl doomtrut.pl yourfile.wad

This will generate 4 files

1) your_new_pnames.txt , for using with XWE

2) unused_textures.txt, the ones you want to remove with XWE

3) unused_patches.txt, idem.

4) pid_changes.txt, a table for replacing the old PID for a new PID in the texture editor on XWE.

Then, in XWE: delete the indicated patches and textures, after that, replace

the contents of PNAMES.

Finally, clean your wad, just in case.

By the way... Give me a filename!".$/ unless defined @ARGV;

die "Only one filename at a time.".$/ if defined $ARGV[1];

$n_lumps = open_wad $ARGV[0];

######################################

# Here we fill the global variables with data

# We put this stuff on separate functions to avoid too many globals

print "==Reading PNAMES==".$/; parse_pnames;

print $/."==Reading TEXTURES=="; parse_textures;

print $/."==Analyzing SIDEDEFS=="; parse_sidedefs;

print $/."==Reading ANIMATED=="; parse_animated;

print $/."==Reading SWITCHES=="; parse_switches;

keep_animated_and_switches;

print $/."==Creating output files==".$/;

create_results;

########################################