#!/usr/bin/perl
my $GENIMAGES = 1;
my $CONVERTER = "convert -quality 100 -colors 16";
require "parsescript.pl";
require "parsebmp.pl";
my $lev0;
my @obj2room;
sub linkobj($) {
my $i = $_[0];
return qq($i);
}
sub linkidx($) {
my $i = $_[0];
return qq($i);
}
sub linkscript($) {
my $i = $_[0];
return qq($i);
}
sub linkbidx($) {
my $i = $_[0];
my $j = int($i / 16);
return qq($i);
}
sub str_to_html($) {
$_ = $_[0];
s/&/&/g;
s//>/g;
s/ö/ö/g;
s/Ö/Ö/g;
s/ä/ä/g;
s/Ä/Ä/g;
s/ü/ü/g;
s/Ü/Ü/g;
s/ß/ß/g;
s/\001(\d*)\002/linkobj($1)/eg;
s/\003(\d*)\002/linkidx($1)/eg;
s/\004(\d*)\002/linkbidx($1)/eg;
s/\005(\d*)\002/linkscript($1)/eg;
return $_;
}
sub read_level($) {
my ($num) = @_;
my $level;
open LVL, sprintf "%02d.lfl", $num;
read LVL, $level, 1024*1024;
close LVL;
$level =~ s/(.)/chr(ord($1)^0xff)/egs;
return $level;
}
sub next_char($) {
local *image = $_[0];
my $i = ord(substr($image,0,1));
$image = substr($image,1);
return $i;
}
$lev0 = &read_level(0);
my $i, $j;
for ($i = 0; $i < 256; $i++) {
@{$varidx[$i]} = ();
}
foreach $i (@ARGV)
{
my $lvl = read_level($i);
$i = sprintf("%02d",$i);
my $n = unpack("c", substr($lvl,0x14));
for ($j = 1; $j <= $n; $j++) {
my $objoff = unpack("v", substr($lvl, 0x1a + 2*($n + $j)));
my $objlen = unpack "v", substr($lvl, $objoff, 2);
my $obj = substr($lvl, $objoff, $objlen);
my $oi = unpack "v", substr $obj, 4, 2;
$obj2room[$oi] = $i;
}
}
foreach $i (@ARGV)
{
my $lvl = read_level($i);
$i = sprintf("%02d",$i);
my ($w,$h,$dummy, $bmpoffset, $maskoffset) = unpack("v5", substr($lvl, 4));
open HTML,">lvl$i.html";
print HTML "room $i\n";
print HTML "Room $i ($w x $h)
\n";
print HTML "![](\"bmp$i.png\")
\n";
print HTML "![](\"mask$i.png\")
\n";
if ($GENIMAGES) {
decode_bmp(substr($lvl, $bmpoffset), $w, $h, "bmp$i.xpm");
decode_mask(substr($lvl, $maskoffset), $w, $h, "mask$i.pbm");
system "$CONVERTER bmp$i.xpm bmp$i.png; rm bmp$i.xpm";
system "$CONVERTER mask$i.pbm mask$i.png; rm mask$i.pbm";
}
my $wbinfo = substr($lvl, ord(substr($lvl,0x15)));
my $wbnr = ord($wbinfo);
print HTML "$wbnr Walkboxes
\n";
print HTML " | | | | | \n";
for $j (0..($wbnr-1)) {
print HTML "$j | ";
}
print HTML "
\n";
for $j (0..($wbnr-1)) {
$yt = ord substr $wbinfo, 8*$j + 1;
$yb = ord substr $wbinfo, 8*$j + 2;
$xlt = ord substr $wbinfo, 8*$j + 3;
$xrt = ord substr $wbinfo, 8*$j + 4;
$xlb = ord substr $wbinfo, 8*$j + 5;
$xrb = ord substr $wbinfo, 8*$j + 6;
$u1 = ord substr $wbinfo, 8*$j + 7;
$flags = ord substr $wbinfo, 8*$j + 8;
print HTML "| $j: | ";
print HTML "($xlt,$yt);($xlb,$yb) | - ($xrt,$yt);($xrb,$yb) | $u1 | $flags | \n";
$rowinfo = substr $wbinfo, 1 + 9 * $wbnr + ord(substr($wbinfo,1 + 8*$wbnr + $j));
for $k (0..($wbnr-1)) {
print HTML "".ord($rowinfo)." | ";
$rowinfo = substr $rowinfo,1;
}
print HTML "
\n";
}
print HTML "
\n";
my $exitscr = unpack("v", substr $lvl, 0x18,2);
my $entryscr = unpack("v", substr $lvl, 0x1a,2);
my $end = unpack("v", substr $lvl, 0x0,2);
if ($entryscr > $exitscr) {
print HTML "Exit Script:
";
print HTML "\n";
print HTML str_to_html(parse_script_to_str(substr $lvl, $exitscr, $entryscr-$exitscr));
print HTML "
\n";
}
if ($end > $entryscr) {
print HTML "Entry Script:
";
print HTML "\n";
print HTML str_to_html(parse_script_to_str(substr $lvl, $entryscr, $end-$entryscr));
print HTML "
\n";
}
my $n = unpack("c", substr($lvl,0x14));
print HTML "$n objects
\n";
for ($j = 1; $j <= $n; $j++) {
$j = sprintf("%03d",$j);
my $objoff = unpack("v", substr($lvl, 0x1a + 2*($n + $j)));
my $objlen = unpack "v", substr($lvl, $objoff, 2);
my $bmpoff = unpack("v", substr($lvl, 0x1a + 2*$j));
my $objbmp = substr($lvl, $bmpoff);
my $obj = substr($lvl, $objoff, $objlen);
my $oi = unpack "v", substr $obj, 4, 2;
my $oc = (ord(substr($obj, 6, 1)) & 0xff);
my $ox = (ord(substr($obj, 7, 1)) & 0xff);
my $oy = (ord(substr($obj, 8, 1)) & 0x7f);
my $ou1 = ord(substr($obj, 8, 1)) & 0x80 ? 1 : 0;
my $ow = (ord(substr($obj, 9, 1)) & 0xff);
my $odo = ord(substr($obj, 0xa, 1)) & 0xff;
my $oax = ord(substr($obj, 0xb, 1)) & 0xff;
my $oay = ord(substr($obj, 0xc, 1)) & 0x1f;
my $oprep = ord(substr($obj, 0xc, 1)) & 0xe0;
my $oaf = ord(substr($obj, 0xd, 1)) & 0x07;
my $oh = ((ord(substr($obj, 0xd, 1)) & 0xff)>>3);
my $onameoff = ord(substr($obj, 0xe, 1));
my $odata = substr($obj, $onameoff);
my $oname = str_to_html(read_strz(\$odata));
my $sstart = length($obj) - length($odata);
print HTML "- object $j", $oname ? " '$oname'":"", "; id $oi
\n";
if (defined $objbmp && $oh != 0 && $ow != 0) {
if ($GENIMAGES) {
if (decode_bmp($objbmp, $ow*8, $oh*8, "obj$i-$j.xpm\n")) {
system "$CONVERTER obj$i-$j.xpm obj$i-$j.png; rm obj$i-$j.xpm";
}
}
if (-e "obj$i-$j.png") {
print HTML "![](\"obj$i-$j.png\")
\n";
}
}
printf HTML "class %02x, ", $oc;
printf HTML "coords: %3d,%3d - %3dx%3d;\n", $ox*8, $oy*8, $ow*8, $oh*8;
if ($odo) {
print HTML "depobj: $odo;\n";
}
print HTML "actorxy: $oax $oay; facing $oaf; preposition $oprep; \n";
print HTML "unknowns: 1:$ou1\n";
my $optr = 0xf;
printf HTML "
verbs: ";
while (($v = ord(substr($obj, $optr++))) != 0) {
print HTML $comma; $comma = ", ";
$v = $verbs[$v] if $verbs[$v];
$soff = ord(substr($obj, $optr++));
printf HTML "$v ->%02x", $soff - $sstart;
}
print HTML"\n";
if (length $odata) {
print HTML "\n";
print HTML str_to_html(parse_script_to_str($odata));
print HTML "
\n";
}
$last = -1;
@usedvars =
grep { $r = $last != $_; $last = $_; $r } sort {$a<=>$b} @usedvars;
# print HTML "Used variables: ".join(",", @usedvars)."
\n";
for $_ (@usedvars) {
push @{$varidx[$_]}, qq(o$oi(r$i));
}
print HTML " \n";
}
print HTML "
\n";
print HTML "\n";
close HTML
}
### read scripts ####
{
my $offset = 2;
# skip objects
$offset += 2 + unpack "v", substr($lev0, $offset, 2);
#skip rooms
$offset += 1 + 3*ord(substr($lev0, $offset, 1));
#skip costumes
$offset += 1 + 3*ord(substr($lev0, $offset, 1));
my $n = (unpack "c", substr($lev0, $offset, 1)) & 0xff;
$offset ++;
for ($i = 1; $i < $n; $i++) {
my $rnr = ord(substr($lev0, $offset + $i,1)) & 0xff;
my $off = unpack "v", substr($lev0, $offset + $n + 2*$i, 2);
next if $rnr == 255;
my $level = read_level($rnr);
$level = substr $level, $off;
$len = unpack("v", $level) &0xffff;
if ($len < length($level)) {
$level = substr($level, 4, $len-4);
}
open HTML,">script$i.html";
print HTML "Script $i\n";
print HTML "Script $i
\n";
print HTML "\n";
print HTML str_to_html(parse_script_to_str($level));
print HTML "
\n";
print HTML "\n";
close HTML;
@usedvars =
grep { $r = $last != $_; $last = $_; $r } sort {$a<=>$b} @usedvars;
for $_ (@usedvars) {
push @{$varidx[$_]}, qq(s$i);
}
parse_script();
}
}
{
open HTML,">vars.html";
print HTML "Variable Index\n";
print HTML "Variable Index
\n";
print HTML "\n";
for ($i = 0; $i < 256; $i++) {
next if !@{$varidx[$i]};
print HTML "- $i:
\n";
print HTML "- ".join(", ", @{$varidx[$i]})."
\n";
}
print HTML "
\n";
print HTML "\n";
close HTML;
}