open LEVEL, "<00.lfl"; read LEVEL, $level, 1024*1024; $level =~ s/(.)/chr(ord($1)^0xff)/egs; close LEVEL; # skip objects $n = unpack "v", substr($level, 2,2); $level = substr($level, 4+$n); #skip unknowns $n = unpack "c", substr($level, 0, 1); $level = substr $level,1+3*$n; #read costumes $n = unpack "c", substr($level, 0, 1); $level = substr $level,1; for ($i = 0; $i < $n; $i++) { $cost[$i] = [ord(substr($level, $i,1))&0xff, unpack "v", substr($level, $n+2*$i, 2) ]; print "Cost $i: ",join ':',@{$cost[$i]},"\n"; } if (!@ARGV) { @list = [1..($n-1)]; } else { @list = @ARGV; } sub clear_sprite() { $minx = 200; $maxx = 0; $miny = 200; $maxy = 0; @imgxy = (); } sub read_sprite_to_img($) { my ($sprite) = @_; my $w = (unpack "v", substr($sprite, 0, 2)) & 0xffff; my $h = (unpack "v", substr($sprite, 2, 2)) & 0xffff; my $x1 = (unpack "v", substr($sprite, 4, 2)) & 0xffff; my $y1 = (unpack "v", substr($sprite, 6, 2)) & 0xffff; my $x2 = $x1 + $w; my $y2 = $y1 + $h; $sprite = substr($sprite, 12); my $x, $y; my $chr, $rep, $color; # print "sprite $w x $h\n"; $minx = $x1 if ($minx > $x1); $miny = $y1 if ($miny > $y1); $maxx = $x2 if ($maxx < $x2); $maxy = $y2 if ($maxy < $y2); $x = $x1; $y = $y1; while ($x < $x2) { $chr = ord($sprite)&0xff; $sprite = substr($sprite, 1); $color = $chr >> 4; $rep = $chr & 0xf; if ($rep == 0) { $rep = ord($sprite)&0xff; $sprite = substr($sprite, 1); } # print "sprite $x, $y: $color, $rep\n"; while ($rep-- > 0) { $imgxy[$x][$y] = $color; $y++; if ($y >= $y2) { $x++; $y = $y1; } } } } sub write_sprite($) { my ($xpm) = @_; my $colchars = ' .XoO+@#$%&*=-;:'; my $w = $maxx - $minx; my $h = $maxy - $miny; open XPM, ">$xpm"; print XPM << "EOF"; /* XPM */ static char *xpm_icon[] = { /* columns rows colors chars-per-pixel */ "$w $h 16 1", " c #808080", ". c #000000", "X c #00aa00", "o c #00aaac", "O c #ac0000", "+ c #ac00ac", "\@ c #ac5500", "# c #acaaac", "\$ c #525552", "\% c #5255ff", "& c #52ff52", "* c #52ffff", "= c #ff5552", "- c #ff55ff", "; c #ffff52", ": c #ffffff", /* pixels */ EOF for ($y = $miny; $y < $maxy; $y++) { print XPM '"'; for ($x = $minx; $x < $maxx; $x++) { if ($imgxy[$x][$y] < 16 && $imgxy[$x][$y] >= 0) { print XPM substr $colchars,$imgxy[$x][$y], 1; } else { print XPM "#"; } } print XPM "\",\n"; } print XPM "};\n"; close XPM; } for $i (@list) { my ($lvl,$off) = @{$cost[$i]}; open LEVEL, sprintf("<%02d.lfl", $lvl); read LEVEL, $level, 1024*1024; $level =~ s/(.)/chr(ord($1)^0xff)/egs; close LEVEL; $costumedata = substr $level, $off; printf "\n$lvl, %04x\n",$off; my $picframes = 0xff & ord(substr $costumedata,4,1); my $picorder = unpack "v", substr $costumedata, 7, 2; printf "picframes: $picframes ; %04x\n", $picorder; for $j (0..($picframes-1)) { $descroff = unpack "v", substr $costumedata, 9 + 32 + 2*$j, 2; last if $descroff == 0; $descr = substr $costumedata, $descroff; $mask = unpack "v", substr $descr,0,2; $descr = substr $descr,2; printf "animation $i-$j mask %04x descroff: %04x\n", $mask, $descroff; $p=0; $xpms = ""; $maxlen = 0; @ordoff = (); @ordlen = (); for $m (0..15) { next if !($mask & (1 << (15-$m))); $ordoff[$m] = ord($descr); if ($ordoff[$m] != 255) { $ordlen[$m] = ord(substr $descr,1)+1; $maxlen = $ordlen[$m] if $maxlen < $ordlen[$m]; $descr = substr $descr,2; $order[$m] = substr $costumedata, $picorder + $ordoff[$m], $ordlen[$m]; } else { $ordlen[$m] = 0; $order = ""; $descr = substr $descr,1; } } print "ordoff:$ordoff len $ordlen\n"; clear_sprite(); for $k (0..($maxlen-1)) { @imgxy = (); for $m (0..15) { next if ! $ordlen[$m]; $nr = ord(substr($order[$m],$k % $ordlen[$m],1)) & 0x7f; $picoffoff = unpack "v", substr($costumedata, 9 + 2*$m, 2); $off = unpack "v", substr $costumedata, $picoffoff + 2*$nr, 2; printf "read $nr in $m@%04x ", $off; next if $off == 0; $sprite = substr $costumedata, $off; read_sprite_to_img $sprite; } $aimgxy[$k] = [ @imgxy ]; } for $k (0..($maxlen-1)) { print " to $i-$j-$k.xpm\n"; $xpms .= " $i-$j-$k.xpm"; @imgxy = @{$aimgxy[$k]}; write_sprite "$i-$j-$k.xpm"; $aimgxy[$k] = undef; @imgxy = @{$aimgxy[$k]}; } print "Converting $xpms\n"; system "convert -delay 20 $xpms cost-$i-$j.gif; rm $xpms"; } }