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!
LVL 1
EcksAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

EcksAuthor Commented:
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();
0
roee_fCommented:
Can you upload somewhere an SPR file?

About the zeroString you can use x operator:
$output = char(0) x $_[0];
0
EcksAuthor Commented:
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!
0
Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

roee_fCommented:
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();
0
roee_fCommented:
Another comment:
in lines 131 of the modified script:

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

You add to $j, $_[1].
At the end of the loop you add to $output a substring with the same length.
BUT, the end-condition of the loop is that $j will be greater/equal than the length of $output.
You understand that the loop will not stop...

OK, by looking in the VB code, you should difrentiate between the RleDecode and $tstr like here:
sub rleDecode() {
      my $tstr;
      my $RleDecode = "";
      
      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";
                  $tstr = $tstr . zeroString(ord(substr($_[0], $i, 1)));
            } else {
                  $tstr = $tstr . substr($_[0], $i, 1);
            }
      }

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

      return $RleDecode;
}


The last one will be on reversePalette. You don't read correctly. You need to start -1024 from EOF.

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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
EcksAuthor Commented:
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.
0
EcksAuthor Commented:
Application is working great now!  Many thanks for the tips and help.

I have a lot of catching up to do with PERL. :)
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Perl

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.