asked on

Run-Length-Encoding Decode Function Help

Hello all. I'm having a little trouble with an RLE decoding function. The output of which is (or "should") be a valid uncompressed BMP data block.

The function takes in the compressed data and the horizontal size, then runs through it thing. But at about a third of the way through, the function seems to lock up and my drive access goes through the roof.

Here is my subroutine (arg 1: the data, arg 2: sizeX)...

<code>sub rleDecode(\$, \$) {
local $output;

local $addup = 4 - ($_[1] % 4);
if ($addup == 4) {
$addup = 0;
}

for (my $i=0; $i < length($_[0]); $i++) {
print $i . " of (" . length($_[0]) . ")\n";
if (ord(substr($_[0], $i, 1)) == 0) {
$i++;
$output = $output . zeroString(substr($_[0], $i, 1));
} else {
$output = $output . substr($_[0], $i, 1);
}
}

for (my $j=0; $j < length($output); $j = $j + $_[1]) {
if ($addup > 0) {
$output = zeroString($addup) . $output;
}
$output = substr($output, $j, $_[1]) . $output;
}

return $output;
}</code>

Notice the first "print" statement in the first for loop. It will get to print around "320 of (1910)" on my test file.

The "zeroString" function puts a series of 'chr(0)' of proper length. It's been a long time since I worked with PERL, so I hope there is a better way to do that too. :)

Can anyone see anything I might be missing, or a loop problem in rleDecode? Many thanks for any help!

Ecks

ASKER

Just in case anyone is interested in seeing the whole thing... here is the complete program at the moment:
(thanks again for any help)

#!/usr/bin/perl

# check for the proper number of command line arguments
if (@ARGV != 1) {
print "Usage: spr2bmp.pl <input.spr>\n";
die;
}

# check if the input file exists
if (!-e $ARGV[0]) {
print "Input file '$ARGV[0]' not found.\n";
die;
}

sub main {
# open the .spr file for reading
open(SPR, "<", $ARGV[0]);

# set binary mode
binmode(SPR);

# pull out the palette at the eof
seek(SPR, 1023, SEEK_END);
read(SPR, $sprPalette, 1024);
$sprPalette = reversePalette($sprPalette);

# return the file pointer to the beginning
seek(SPR, 0, SEEK_SET);

# check for the magic number
read(SPR, $magic, 4);
if ($magic ne "SP" . chr(1) . chr(2)) {
print "File does not appear to be a valid SPR\n";
die;
}

# read in the number of images in the sprite
read(SPR, $imgCount, 2);
$imgCount = unpack("s", $imgCount);

# skip 2 bytes
seek(SPR, 2, 1);

# cycle through the images in the sprite
#for (my $i=0; $i < $imgCount; $i++) {
for (my $i=0; $i < 1; $i++) {
# get sprite width
read(SPR, $sizeX, 2);
$sizeX = unpack("s", $sizeX);

# get sprite height
read(SPR, $sizeY, 2);
$sizeY = unpack("s", $sizeY);

# get the compressed data size
read(SPR, $compSize, 2);
$compSize = unpack("s", $compSize);

# pull out the compressed data
read(SPR, $compData, $compSize);

# decode the compress data
$bmpData = rleDecode($compData, $sizeX);

# output bmp
open(BMP, ">", $ARGV[0] . "." . $i . ".bmp") or die("failed to open output file");
binmode(BMP);

print BMP "BM";

print BMP pack("l", 14 + 40 + length($sprPalette) + len($bmpData));
print BMP pack("l", 0);
print BMP pack("l", 14 + 40 + length($sprPalette));

print BMP pack("l", 40);
print BMP pack("l", $sizeX);
print BMP pack("l", $sizeY);
print BMP pack("i", 1); # number of planes
print BMP pack("l", 8); # 8 bit color
print BMP pack("l", 0); # no compression

print BMP pack("l", length($bmpData)); # bitmap size
print BMP pack("l", 0);
print BMP pack("l", 0);
print BMP pack("l", 256); # number of colors used
print BMP pack("l", 0); # number of important colors

print BMP $sprPalette;
print BMP $bmpData;

close(BMP);
}

close(SPR);
}

sub reversePalette(\$) {
local $output;

for (my $i=0; $i < length($_[0]); $i=$i+4) {
$output = $output . substr($_[0], $i+2, 1) . substr($_[0], $i+1, 1) + substr($_[0], $i+0, 1) . chr(0);
}

return $output;
}

sub rleDecode(\$, \$) {
local $output;

local $addup = 4 - ($_[1] % 4);
if ($addup == 4) {
$addup = 0;
}

for (my $i=0; $i < length($_[0]); $i++) {
print $i . " of (" . length($_[0]) . ")\n";
if (ord(substr($_[0], $i, 1)) == 0) {
$i++;
$output = $output . zeroString(substr($_[0], $i, 1));
} else {
$output = $output . substr($_[0], $i, 1);
}
}

for (my $j=0; $j < length($output); $j = $j + $_[1]) {
if ($addup > 0) {
$output = zeroString($addup) . $output;
}
$output = substr($output, $j, $_[1]) . $output;
}

return $output;
}

# there has got to be a better way
sub zeroString(\$) {
local $ouput = "";

for (my $i=0; $i < $_[0]; $i++) {
$output = $output . chr(0);
}

return $output;
}

# execute the main function
main();

roee_f

Can you upload somewhere an SPR file?

About the zeroString you can use x operator:
$output = char(0) x $_[0];

Ecks

ASKER

An SPR example file can be found here: http://www.rightstep.org/sprinfo.zip

The file contains an SPR with 47 images in it. The first BMP that would be extracted is also included in the archive, extracted via a VB application I am using to decipher the specs. I have also included the VB form in the archive as well.

Thanks for the 'zeroString' shortcut!

roee_f

Wow, this in ancient code...

Here is a start and two clues.
I've replaced all of the local with my, since this is what you really want.
Also, I've added "use strict" and "use warnings", which you should.
I've removed the prototypes from the subs headers.
I've added some "my" declarations in order to pass the strictness, you've had a wrong variable in zeroString (outpu vs. $output).

Your program has a lots of warnings, which I can't fix since your variables has no meaningful names.
Anyway, when I've replaced the code in zeroString, one error popped out. You call it with a non-number variable, while it expects a number.

Try to look at this script and guide me further if you need:

#!/usr/bin/perl
use strict;
use IO::File; # roee_f for SEEK_*

use warnings;
# # check for the proper number of command line arguments
# if (@ARGV != 1) {
#       print "Usage: spr2bmp.pl <input.spr>\n";
#       die;
# }

# # check if the input file exists
# if (!-e $ARGV[0]) {
#       print "Input file '$ARGV[0]' not found.\n";
#       die;
# }

sub main {
      # open the .spr file for reading
      open(SPR, "<", "zombie.spr") or die "Cannot find file\n";
      my ($sprPalette, $magic, $imgCount, $sizeX, $sizeY, $compSize, $compData, $bmpData); # roee_f
      # set binary mode
      binmode(SPR);

      # pull out the palette at the eof
      seek(SPR, 1023, SEEK_END);
      read(SPR, $sprPalette, 1024);
      $sprPalette = reversePalette($sprPalette);

      # return the file pointer to the beginning
      seek(SPR, 0, SEEK_SET);

      # check for the magic number
      read(SPR, $magic, 4);
      if ($magic ne "SP" . chr(1) . chr(2)) {
            print "File does not appear to be a valid SPR\n";
            die;
      }

      # read in the number of images in the sprite
      read(SPR, $imgCount, 2);
      $imgCount = unpack("s", $imgCount);

      # skip 2 bytes
      seek(SPR, 2, 1);

      # cycle through the images in the sprite
      #for (my $i=0; $i < $imgCount; $i++) {
      for (my $i=0; $i < 1; $i++) {
            # get sprite width
            read(SPR, $sizeX, 2);
            $sizeX = unpack("s", $sizeX);

            # get sprite height
            read(SPR, $sizeY, 2);
            $sizeY = unpack("s", $sizeY);

            # get the compressed data size
            read(SPR, $compSize, 2);
            $compSize = unpack("s", $compSize);

            # pull out the compressed data
            read(SPR, $compData, $compSize);

            # decode the compress data
            $bmpData = rleDecode($compData, $sizeX);

            # output bmp
            open(BMP, ">", $ARGV[0] . "." . $i . ".bmp") or die("failed to open output file");
            binmode(BMP);

            print BMP "BM";

            print BMP pack("l", 14 + 40 + length($sprPalette) + len($bmpData));
            print BMP pack("l", 0);
            print BMP pack("l", 14 + 40 + length($sprPalette));

            print BMP pack("l", 40);
            print BMP pack("l", $sizeX);
            print BMP pack("l", $sizeY);
            print BMP pack("i", 1);                   # number of planes
            print BMP pack("l", 8);                   # 8 bit color
            print BMP pack("l", 0);                   # no compression

            print BMP pack("l", length($bmpData));      # bitmap size
            print BMP pack("l", 0);
            print BMP pack("l", 0);
            print BMP pack("l", 256);      # number of colors used
            print BMP pack("l", 0);            # number of important colors

            print BMP $sprPalette;
            print BMP $bmpData;

            close(BMP);
      }

      close(SPR);
}

sub reversePalette() {
      my $output;

      for (my $i=0; $i < length($_[0]); $i=$i+4) {
            $output = $output . substr($_[0], $i+2, 1) . substr($_[0], $i+1, 1) + substr($_[0], $i+0, 1) . chr(0);
      }

      return $output;
}

sub rleDecode() {
      my $output;
      my $dbgsubstr;

      my $addup = 4 - ($_[1] % 4);
      if ($addup == 4) {
            $addup = 0;
      }

      for (my $i=0; $i < length($_[0]); $i++) {
            print $i . " of (" . length($_[0]) . ")\n";
            if (ord(substr($_[0], $i, 1)) == 0) {
                  $i++;
                  print substr($_[0], $i, 1)."<<<\n";
                  $output = $output . zeroString(substr($_[0], $i, 1));
            } else {
                  $output = $output . substr($_[0], $i, 1);
            }
      }

      for (my $j=0; $j < length($output); $j = $j + $_[1]) {
            if ($addup > 0) {
                  $output = zeroString($addup) . $output;
            }
            $output = substr($output, $j, $_[1]) . $output;
      }

      return $output;
}

# there has got to be a better way
sub zeroString() {
      my $output = ""; # roee_f

       for (my $i=0; $i < $_[0]; $i++) {
             $output = $output . chr(0);
       }
#       $output = char(0) x $_[0];
      return $output;
}

# execute the main function
main();

ASKER CERTIFIED SOLUTION

roee_f

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Ecks

ASKER

Thanks roee_f, I'm looking over everything now and checking out the changes.

> (This is NOT a 125 points question...)

It started out that way, I just figured I needed a little help with the rleDecode function. ;) I have plenty of points to burn, I'll up it an appropriate count on close.

Ecks

ASKER

Application is working great now! Many thanks for the tips and help.

I have a lot of catching up to do with PERL. :)