?
Solved

Run-Length-Encoding Decode Function Help

Posted on 2004-12-01
7
Medium Priority
?
475 Views
Last Modified: 2008-02-01
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!
0
Comment
Question by:Ecks
  • 4
  • 3
7 Comments
 
LVL 1

Author Comment

by:Ecks
ID: 12717752
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
 
LVL 5

Expert Comment

by:roee_f
ID: 12718267
Can you upload somewhere an SPR file?

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

Author Comment

by:Ecks
ID: 12718369
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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 5

Expert Comment

by:roee_f
ID: 12718730
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
 
LVL 5

Accepted Solution

by:
roee_f earned 2000 total points
ID: 12719554
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
 
LVL 1

Author Comment

by:Ecks
ID: 12721745
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
 
LVL 1

Author Comment

by:Ecks
ID: 12722493
Application is working great now!  Many thanks for the tips and help.

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

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

There are many situations when we need to display the data in sorted order. For example: Student details by name or by rank or by total marks etc. If you are working on data driven based projects then you will use sorting techniques very frequently.…
Checking the Alert Log in AWS RDS Oracle can be a pain through their user interface.  I made a script to download the Alert Log, look for errors, and email me the trace files.  In this article I'll describe what I did and share my script.
Explain concepts important to validation of email addresses with regular expressions. Applies to most languages/tools that uses regular expressions. Consider email address RFCs: Look at HTML5 form input element (with type=email) regex pattern: T…
Six Sigma Control Plans
Suggested Courses

621 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question