#!/usr/bin/perl
use strict;
use warnings;
use Carp;
$|=1;
use Win32::Process::List;
use Win32::Process;
use Win32::Process::Memory;
use Compress::Zlib;
### set up variables ###########################################################
################################################################################
my ($dwarf_pid, $pe_timestamp, $ver, $input);
my $pe_timestamp_offset = 0x004000F8;
my @offsets = (
{
version => "v0.27.169.33a",
PE => 0x4729DA32,
map_loc => 0x01458568,
x_count => 0x01458580,
y_count => 0x01458584,
z_count => 0x01458588
},
{
version => "v0.27.169.33b",
PE => 0x473E7E49,
map_loc => 0x01459568,
x_count => 0x01459580,
y_count => 0x01459584,
z_count => 0x01459588
},
{
version => "v0.27.169.33c",
PE => 0x47480E76,
map_loc => 0x0145F560,
x_count => 0x0145F578,
y_count => 0x0145F57C,
z_count => 0x0145F580
},
{
version => "v0.27.169.33d",
PE => 0x475099AA,
map_loc => 0x01460560,
x_count => 0x01460578,
y_count => 0x0146057C,
z_count => 0x01460580
},
{
version => "v0.27.169.33e",
PE => 0x475B7526,
map_loc => 0x01461560,
x_count => 0x01461578,
y_count => 0x0146157C,
z_count => 0x01461580
},
{
version => "v0.27.169.33f",
PE => 0x4763710C,
map_loc => 0x01462568,
x_count => 0x01462580,
y_count => 0x01462584,
z_count => 0x01462588
},
{
version => "v0.27.169.33g",
PE => 0x476CA6CE,
map_loc => 0x01469680,
x_count => 0x01469698,
y_count => 0x0146969C,
z_count => 0x014696A0
},
);
my $tile_type_offset = 0x005E;
my $tile_designation_offset = 0x0260;
my $tile_occupancy_offset = 0x0660;
my $proc;
my @full_map_data; # array to hold the full extracted map data
### get dwarf process id #######################################################
################################################################################
my %list = Win32::Process::List->new()->GetProcesses();
for my $key ( keys %list ) {
$dwarf_pid = $key if ( $list{$key} =~ /dwarfort.exe/ );
}
croak "Couldn't find process ID, make sure DF is running and a savegame is loaded." unless ( $dwarf_pid );
### lower priority of dwarf fortress ###########################################
################################################################################
Win32::Process::Open( my $dwarf_process, $dwarf_pid, 1 );
$dwarf_process->SetPriorityClass( IDLE_PRIORITY_CLASS );
croak "Couldn't lower process priority, this is really odd and shouldn't happen, try running as administrator or poke Mithaldu/Xenofur." unless ( $dwarf_process );
### actually read stuff from memory ############################################
################################################################################
$proc = Win32::Process::Memory->new({ pid => $dwarf_pid, access => 'read/query' }); # open process with read access
croak "Couldn't open memory access to Dwarf Fortress, this is really odd and shouldn't happen, try running as administrator or poke Mithaldu/Xenofur." unless ( $proc );
### Let's Pla... erm, figure out what version this is ##########################
################################################################################
$pe_timestamp = $proc->get_u32( $pe_timestamp_offset );
for my $i ( 0..$#offsets ) {
if ( $offsets[$i]{PE} == $pe_timestamp ) {
print "We seem to be using: DF $offsets[$i]{version}\nIf this is correct, press enter. If not, please CTRL+C now and contact Xenofur/Mithaldu, as you might risk disastrous and hilarious results.\n";
$input = <STDIN>;
$ver = $i;
last;
}
}
print "Processing map data.\n";
loadmap();
undef $proc; # close process
print "Press enter to close...";
$input = <STDIN>;
################################################################################
sub loadmap {
print "Loading map data.\n";
my $map_base; # offset of the address where the map blocks start
my ($xcount, $ycount, $zcount); # dimensions of the map data we're dealing with
my (@xoffsets,@yoffsets,@zoffsets); # arrays to store the offsets of the place where other addresses are stored
@full_map_data=[]; # array to hold the full extracted map data
$map_base = $proc->get_u32( $offsets[$ver]{map_loc} ); # checking whether the game has a map already
croak "Map data is not yet available, make sure you have a game loaded." unless ( $map_base );
$xcount = $proc->get_u32( $offsets[$ver]{x_count} ); # find out how much data we're dealing with
$ycount = $proc->get_u32( $offsets[$ver]{y_count} );
$zcount = $proc->get_u32( $offsets[$ver]{z_count} );
# get the offsets of the address storages for each x-slice and cycle through
@xoffsets = $proc->get_packs("L", 4, $map_base, $xcount);
for my $bx ( 0..$#xoffsets ) {
# get the offsets of the address storages for each y-column in this x-slice and cycle through
@yoffsets = $proc->get_packs("L", 4, $xoffsets[$bx], $ycount);
for my $by ( 0..$#yoffsets ) {
# get the offsets of each z-block in this y-column and cycle through
@zoffsets = $proc->get_packs("L", 4, $yoffsets[$by], $zcount);
for my $bz ( 0..$#zoffsets ) {
next if ( $zoffsets[$bz] == 0 ); # go to the next block if this one is not allocated
process_block( # process the data in one block
$zoffsets[$bz], # offset of the current block
$bx, # x location of the current block
$by, # y location of the current block
$bz ); # z location of the current block
}
}
}
print "Done reading DF memory, printing to files.\n";
print_files( $xcount, $ycount, $zcount );
print "Files printed, shutting down.\n";
}
sub process_block {
my ($block_offset, $bx, $by, $bz) = @_;
my @type_data = $proc->get_packs( # extract type/designation/occupation arrays for this block
"S", 2, # format and size in bytes of each data unit
$block_offset+$tile_type_offset, # starting offset
256); # number of units
my @designation_data = $proc->get_packs("L", 4, $block_offset+$tile_designation_offset, 256);
my @ocupation_data = $proc->get_packs("L", 4, $block_offset+$tile_occupancy_offset, 256);
for my $y ( 0..15 ) { # cycle through 16 x and 16 y values, which generate a total of 256 tile indexes
for my $x ( 0..15 ) {
my $tile_index = $y+($x*16); # this calculates the tile index we are currently at, from the x and y coords in this block
my $real_x = ($bx*16)+$x; # this calculates the real x and y values of this tile on the overall map_base
my $real_y = ($by*16)+$y;
$full_map_data[$real_x][$real_y][$bz] = # store in the array that holds the full map data :
$type_data[$tile_index] . ":" . # the type data of the tile with the current index
$designation_data[$tile_index] . ":" . # the designation data of the tile with the current index
$ocupation_data[$tile_index]; # the occupation data of the tile with the current index
}
}
}
sub print_files {
my ($xcount, $ycount, $zcount) = @_;
print "Please enter the name of your fortress (1 word, alphanumeric + _): ";
my $map_name = <STDIN>;
$map_name =~ /.*?(\w+).*?/;
$map_name = $1;
my $page = "$map_name|$xcount|$ycount\n";
my $page2 = "$map_name|$xcount|$ycount\n";
for my $z ( 0..$zcount-1 ) {
my $map1 = sprintf ("-%03d-\n", $z);
my $map2 = sprintf ("-%03d-\n", $z);
my $allocated;
for my $y ( 0..($ycount*16)-1 ) {
my $line1;
my $line2;
for my $x ( 0..($xcount*16)-1 ) {
if ($full_map_data[$x][$y][$z]) {
$line1 .= sprintf ( "%4d ", split (/:/, $full_map_data[$x][$y][$z], 2) );
$line2 .= $full_map_data[$x][$y][$z]."|";
$allocated = 1;
}
else {
$line1 .= " -1 ";
$line2 .= "-1|";
}
}
$line2 =~ s/\|$//;
$map1 .= $line1."\n";
$map2 .= $line2."\n";
}
if ($allocated) {
$map1 =~ s/\n$//;
$map2 =~ s/\n$//;
$page .= $map1."\n";
$page2 .= $map2."\n";
}
print " ". $z+1 ." / $zcount \n";
}
$page =~ s/\n$//;
$page2 =~ s/\n$//;
open my $DAT, ">", "lite_$map_name.txt" or croak( "horribly: $!" );
print $DAT $page;
close $DAT;
my $gz = gzopen("full_$map_name.txt.gz", "wb9") or croak( "horribly: ".$gzerrno );
$gz->gzwrite($page2) or croak( "horribly: ".$gzerrno );
$gz->gzclose ;
}
__END__
# some notes:
################################################################################
#print "\nContent of $df_offset -> $df_offset + 0x80\n"; # do a hex dump starting at offset with given length
#print $proc->hexdump( $df_offset, 0x80 );
#
#$proc->get_buf( $df_offset, 10, my $string_buffer ); # read and output various values
#printf ( "\n0x%X [string of length 10] : %s\n", $df_offset, $string_buffer );
#printf ( "0x%X [unsigned int8 in hex] : %x\n", $df_offset, $proc->get_u8($df_offset) );
#printf ( "0x%X [unsigned int16 in hex] : %x\n", $df_offset, $proc->get_u16($df_offset) );
#printf ( "0x%X [unsigned int32 in hex] : %x\n", $df_offset, $proc->get_u32($df_offset) );
# Sample Output:
#
# Content of 8995724 -> 8995724 + 0x80
# 00894380 : 44 77 61 72 : Dwar
# 00894390 : 66 20 46 6F 72 74 72 65 73 73 00 00 45 72 72 6F : f Fortress..Erro
# 008943A0 : 72 00 00 00 45 72 72 6F 72 20 52 65 67 69 73 74 : r...Error Regist
# 008943B0 : 65 72 69 6E 67 20 57 69 6E 64 6F 77 20 43 6C 61 : ering Window Cla
# 008943C0 : 73 73 21 00 45 72 72 6F 72 20 43 72 65 61 74 69 : ss!.Error Creati
# 008943D0 : 6E 67 20 4F 70 65 6E 47 4C 20 57 69 6E 64 6F 77 : ng OpenGL Window
# 008943E0 : 00 00 00 00 72 62 00 00 4D 6F 64 65 20 53 77 69 : ....rb..Mode Swi
# 008943F0 : 74 63 68 20 46 61 69 6C 65 64 2E 0A 52 75 6E 6E : tch Failed..Runn
# 00894400 : 69 6E 67 20 49 6E 20 57 69 6E 64 6F : ing In Windo
#
# 0x89438C [string of length 10] : Dwarf Fort
# 0x89438C [unsigned int8 in hex] : 44
# 0x89438C [unsigned int16 in hex] : 7744
# 0x89438C [unsigned int32 in hex] : 72617744