Convert BMP to HTML

Replies are listed 'Best First'.

Re: Convert BMP to HTML
by GrandFather (Saint) on Oct 30, 2022 at 08:36 UTC

So where is the script?

Optimising for fewest key strokes only makes sense transmitting to Pluto or beyond

by harangzsolt33 (Chaplain) on Oct 31, 2022 at 02:25 UTC

#!/usr/bin/perl -w
#
#  BMP2HTML is a tool that converts any BMP file to simple HTML code.
#  Written by Zsolt N. Perry (zsnp@juno.com), Pensacola, Florida.
#  This Perl script was tested with TinyPerl 5.8 under Windows XP.
#
use 5.004;
use strict;
use warnings;
$| = 1;

my $BMPFILE = "D:\\DESKTOP\\BMP\\x32.bmp";
my $HTMFILE = "D:\\DESKTOP\\BMP\\Test3344.html";

my $CANVAS = ReadBMP($BMPFILE, 24);
#ConvertToWebColors($CANVAS);
my $HTML = Canvas2HTML($CANVAS);
CreateFile($HTMFILE, $HTML);
exit;

##################################################
#                     BMP | Graphics | v2022.11.15
# Use this function to read and decode any kind of
# BMP file. Returns a canvas object. Returns a
# 0 x 0 blank canvas if something goes wrong.
#
# The first argument is the BMP file name.
# The second argument tells this function how many
# bytes to use to store each pixel. There are only
# three valid values: 1, 3, 4.
#
# This function supports all types of BMP formats.
# It can read old OS/2 BMP images, RLE compressed
# BMP images, standard BMP images (no compression),
# and custom format BMP images with or without
# palette and transparency.
#
# Usage: CANVASREF = ReadBMP(FILENAME, [DEPTH])
#
sub ReadBMP
{
  my $D = GetBPP($_[1]);
  my $BMPINFO = ReadBMPHeader($_[0]);
  my $FMT = vec($BMPINFO, 0, 16);
  if ($FMT == 0x100) { return ReadStandardBMP($BMPINFO, $D); }
  if ($FMT == 0x200) { return ReadCustomBMP($BMPINFO, $D); }
  if ($FMT == 0x300) { return ExpandRLE($BMPINFO, $D); }
  return BlankCanvas($D);
}
##################################################
#                     BMP | Graphics | v2022.11.21
# This function reads a BMP file's header and
# returns a bunch of values encapsulated in a
# string using the pack() function.
#
# Usage: BMPINFO = ReadBMPHeader(FILENAME)
#
sub ReadBMPHeader
{
  my $F = FilterFileName($_[0]);
  my ($BMPINFO, $HEADER, $FMT, $E) = ('', '', 0, 0);

  # The following foreach() loop allows us to exit the function
  # conveniently using a common exit route. Everything inside the
  # loop will run only once. If there is an error, we skip to the
  # end quickly using the "last" statement. If there are no
  # errors, we go through all the steps and exit at the bottom
  # at the same place. $E will hold the error code.
  # If no errors occurred, then $E will be zero.

  foreach (0)
  {
    # Read the first 1200 bytes from the file.
    ($E = ReadFile($_[0], $HEADER, 0, 1200)) and last;
    vec($HEADER, 1200, 8) = 0;  # Expand header if it was shorter.

    # Unpack header values.
    my ($SIG, $FILESIZE, $RESERVED, $DATAPTR, $BMPVER)
         = unpack('vV4', $HEADER);
    my ($W, $H, $PLANES, $BPP) = unpack($BMPVER < 16 ?
         'v4' : 'VVvv', substr($HEADER, 18, 12));
    my ($COMPR, $DATASIZE, $XRES, $YRES, $COLORS, $IC) = $BMPVER > 16
          ? unpack('V6', substr($HEADER, 30, 24)) : (0) x 6;
    my $BGRS = ($BPP <= 8 && substr($HEADER, 54, 4) eq 'BGRs') & 1;

    # Check file signature.
    if ($SIG != 0x4D42) { $E = 4; last; }  # Not a BMP file

    # Figure out what kind of encoding is used.
    if ($COMPR == 0)                 { $FMT = 1; }  # Standard (raw)
    elsif ($BMPVER >= 56 && $DATAPTR >= 70
     && $BPP >= 16 && $COMPR == 3)   { $FMT = 2; }  # Custom format
    elsif (($BPP == 4 || $BPP == 8) &&
     ($COMPR == 1 || $COMPR == 2))   { $FMT = 3; }  # RLE Compressed
    else  { $E = 5; print last; }  # Corrupt file

    # Read bit masks for custom format.
    my ($RMASK, $GMASK, $BMASK, $AMASK) = ($FMT == 2) ?
       unpack('V4', substr($HEADER, 54, 16)) : (0) x 4;

    # Calculate image height.
    my $VFLIP = 1;  # VFLIP=1 means the image is stored upside down
    if ($H & 0x80000000) { $VFLIP = 0; $H = NEG32($H); }
    if ($W == 0 || $H == 0) { $E = 6; last; }

    # Copy palette from BMP header.
    my $MAXCOLORS = 16777216;
    if ($FMT == 2) { $MAXCOLORS =
      POWER(2, CountBits32($RMASK | $GMASK | $BMASK)); }
    elsif ($BPP < 24) { $MAXCOLORS = 1 << $BPP; }
    my $PALPTR = $BMPVER + 14;
    my $PALWIDTH = $BMPVER < 16 ? 3 : 4;   # $CC is the COLOR COUNT.
    my $CC = $COLORS && $COLORS < $MAXCOLORS ? $COLORS : $MAXCOLORS;
    if ($FMT >= 3 || $BPP > 8) { $CC = $PALWIDTH = $PALPTR = 0; }
    my $PALETTE = ReadBMPPalette($HEADER, $PALPTR, $PALWIDTH, $CC);

    # Perform some calculations...
    my $ROWLEN = int(($W * $BPP + 7) / 8);   # Bytes per row
    my $PADDING = (4 - ($ROWLEN & 3)) & 3;   # Padding bytes per row
    my ($DIR, $START, $STOP) = $VFLIP ? (-1, $H, -1) : (1, 1, $H);
    $ROWLEN += $PADDING;
    $START--;

    # Everything seems to be OK.
    $BMPINFO = pack('C6V20v5c', $FMT, $E, $VFLIP, $PADDING, $BGRS,
        $PALWIDTH, $W, $H, $COMPR, $BMPVER, $COLORS, $XRES, $YRES,
        $MAXCOLORS, $FILESIZE, $DATASIZE, $DATAPTR, $RESERVED, $IC,
        $ROWLEN, $START, $STOP, $RMASK, $GMASK, $BMASK, $AMASK,
        $BPP, $SIG, $PLANES, $PALPTR, $CC, $DIR) . $PALETTE;
  }
  vec($BMPINFO, 1, 8) = $E;  # Save error code
  vec($BMPINFO, 1122, 8) = 0;  # Expand BMPINFO
  undef $HEADER;
  return $BMPINFO . $F;
}
##################################################
#                     BMP | Graphics | v2022.11.16
# This function reads a BMP file that uses the simplest
# form of encoding. Returns a reference to a canvas object.
#
# Usage: CANVASREF = ReadStandardBMP(BMPINFO, [DEPTH])
#
sub ReadStandardBMP
{
  my ($FMT, $E, $VFLIP, $PADDING, $BGRS, $PALWIDTH, $W, $H, $COMPR,
      $BMPVER, $COLORS, $XRES, $YRES, $MAXCOLORS, $FILESIZE,
      $DATASIZE, $DATAPTR, $RESERVED, $IC, $ROWLEN, $START, $STOP,
      $RMASK, $GMASK, $BMASK, $AMASK, $BPP, $SIG, $PLANES, $PALPTR,
      $CC, $DIR, $PALETTE, $F) = UnpackBMPINFO($_[0]);
  print "$FMT $E $VFLIP $PADDING $BGRS\n";
  my $D = GetBPP(defined $_[1] ? $_[1] : $BPP);

  print "\nReading BMP file: $F  (", Commify(-s $F), ' bytes)',
        "\nDecoding $W x $H x $BPP uncompressed BMP image...";

  my ($BYTE, $COLOR, $PX, $A, $R, $G, $B) = (0) x 7;

  my $SHIFT = 7;  # The $SHIFT variable is only used when reading
  # monochrome bitmaps where each bit represents one pixel, so we
  # have to shift the bits left to extract them. The first pixel is
  # always stored in the highest bit, so we start with $SHIFT = 7.

  # Create canvas right here.
  my $CANVAS = sprintf('CANVAS%0.2d', $D << 3) . pack('NN', $W, $H);
  vec($CANVAS, $W * $H * $D + 15, 8) = 0;  # Fill canvas.
  if ($D == 1 && $BPP > 8) {
    $PALWIDTH = 4;
    $PALETTE = Build256CPalette();
    $CANVAS .= $PALETTE;
  }
  elsif ($D == 1) { $CANVAS .= $PALETTE; }

  my $P = 16;  # Canvas byte pointer to first pixel

  # Open file for read only.
  local *FILE;
  sysopen(FILE, $F, 0) or return \$CANVAS;
  binmode FILE;
  for (my $Y = $START; $Y != $STOP; $Y += $DIR)
  {
    # Move the file pointer to the beginning of row $Y
    seek(FILE, $Y * $ROWLEN + $DATAPTR, 0);
    for (my $X = 0; $X < $W; $X++)
    {
      if ($BPP <= 8)
      {
        # Read 8-bit pixel:
        if ($BPP == 8) { $COLOR = ord(getc(FILE)); }

        # Read 4-bit pixel:
        elsif ($BPP == 4) { $COLOR = ($X & 1) ?
          $BYTE & 15 : ($BYTE = ord(getc(FILE))) >> 4; }

        # Read 1-bit pixel:
        elsif ($BPP == 1) { $COLOR = ($X & 7) ?
          ($BYTE >> --$SHIFT) & 1 :
          ($BYTE = ord(getc(FILE))) >> ($SHIFT = 7); }

        # Look up R G B values in palette if we have to upscale
        # the image from 8bpp to 24bpp or 32bpp.
        if ($D >= 3 && $BPP <= 8)
        {
          $COLOR <<= 2;
          $A = vec($PALETTE, $COLOR, 8);
          $R = vec($PALETTE, $COLOR+1, 8);
          $G = vec($PALETTE, $COLOR+2, 8);
          $B = vec($PALETTE, $COLOR+3, 8);
        }
      }
      elsif ($BPP >= 24)   # Read 24-bit or 32-bit pixel
      {
        $B = ord(getc(FILE));
        $G = ord(getc(FILE));
        $R = ord(getc(FILE));
        $A = ord(getc(FILE)) if ($BPP == 32);
        if ($D == 1)
        {
          $COLOR = Match_Palette_Color($PALETTE, $R, $G, $B);
        }
      }

      # Save pixel to canvas as 8-bit, 24-bit, or 32-bit:
      if ($D == 1) { vec($CANVAS, $P++, 8) = $COLOR; }
      else { if ($D > 3) { vec($CANVAS, $P++, 8) = $A; }
        substr($CANVAS, $P, 3) = pack('CCC', $R, $G, $B); $P += 3; }

      $PX++ < 10000 or $PX = print '.';
    }
  }
  close FILE;
  print "\nDONE.\n";
  return \$CANVAS;
}
##################################################
#                     BMP | Graphics | v2022.11.19
# This function reads a custom format BMP file.
# Returns a reference to a canvas object.
#
# Usage: CANVASREF = ReadCustomBMP(BMPINFO, DEPTH)
#
# BMPINFO: The first argument must be a special string
# that is generated by the ReadBMPHeader() function.
#
# DEPTH: The second argument is the requested image depth
# for the canvas. This value may be provided in bytes per pixel
# or bits per pixel. Valid values are: 1, 3, 4, 8, 24, 32.
#
# CANVASREF: The return value of this function is a reference
# that points to a string which contains the image data.
# The first 8 bytes of this string will contain the word
# "CANVAS24" or "CANVAS32" depending on the encoding, followed
# by the width and height of the image which are encoded as
# two 32-bit unsigned integers stored in big-endian format.
# After this 16-byte header, the pixels are stored in raw
# format starting with the first pixel in the upper left corner.
# When "CANVAS24" is used, the pixels are in RGB order.
# When "CANVAS32" is used, the pixels are in ARGB order.
# The canvas contains no padding at all, just raw data.
#
# WHAT IS CUSTOM FORMAT ?
#
# Custom format means that the BMP header includes
# four 32-bit integers which are used as bit masks
# that tell us where the bits are stored for red,
# green, blue and alpha values. Here is an example:
#  AMASK=0000000f    This tells us that the alpha value
#  RMASK=000000f0    is stored in the lowest 4 bits,
#  GMASK=00000f00    followed by red, which is stored
#  BMASK=0000f000    in the next 4 bits, then 4-bits
# for green, and 4 bits for blue. We would represent
# this encoding as A4 R4 G4 B4. As you can see, this
# adds up to 16 bits. So, that's 16 bits per pixel.
#
# You will find this representation in Adobe PhotoShop.
# When you save a picture in BMP format, it gives you a
# number of options such as A1 R5 G5 B5, A8 R8 G8 B8,
# R5 G6 B5, and others. There are many possibilities.
#
# Unfortunately, most of these special formats result in
# a loss of quality. For example, if the picture includes
# a purple color such as R=204 G=83 B=255 and we wanted to
# store it in 16 bits in the format specified above, we
# would start out like this: R=11001100 G=01010011 B=11111111
# Then we will keep only the high 4 bits R=1100 G=0101 B=1111
# and then join them together to form one 16-bit number:
#   1111 + 0101 + 1100 + 0000 => 1111010111000000
# So, that's how we store one pixel in custom format.
#
# For decoding, we do the same steps in reverse.
# We use the bit masks to extract the values from one
# 16-bit pixel:  1111010111000000
#   RED MASK  :  0000000011110000
#   RED VALUE :  --------1100----
#   RED VALUE :          1100
#   RED VALUE :        11000000
#
# 16-bit pixel:  1111010111000000
# GREEN MASK  :  0000111100000000
# GREEN VALUE :  ----0101--------
# GREEN VALUE :      0101
# GREEN VALUE :    01010000
#
# So, we will have R=1100 G=0101 B=1111 which becomes
# R=11000000 G=01010000 B=11110000 (R=192 G=80 B=240).
# So, the original color was R=204 G=83 B=255, and you
# can see that we ended up with a slightly different
# color. It's still a purple, but it's a little bit off.
# To try to correct this problem, we use a color stretch
# lookup table. See BuildColorStretchTable() for more info.
#
# When using custom format, the Compression value must
# be set to 3, and the Bits Per Pixel value can be 16,
# 24 or 32. The header must use BMP version 56 or above.
#
# Usage: CANVASREF = ReadCustomBMP(BMPINFO, DEPTH)
#
sub ReadCustomBMP
{
  my ($FMT, $E, $VFLIP, $PADDING, $BGRS, $PALWIDTH, $W, $H, $COMPR,
      $BMPVER, $COLORS, $XRES, $YRES, $MAXCOLORS, $FILESIZE,
      $DATASIZE, $DATAPTR, $RESERVED, $IC, $ROWLEN, $START, $STOP,
      $RMASK, $GMASK, $BMASK, $AMASK, $BPP, $SIG, $PLANES, $PALPTR,
      $CC, $DIR, $PALETTE, $F) = UnpackBMPINFO($_[0]);
  my $D = GetBPP(defined $_[1] ? $_[1] : $BPP);

  print "\nReading BMP file: $F  (", Commify(-s $F), ' bytes)',
        "\nDecoding $W x $H custom format BMP image ",
        "($BPP bpp => ", ($D << 3), ' bpp) ';

  my ($PX, $PIXEL, $A, $R, $G, $B) = (0) x 7;

  # Okay. This is just preparation work.
  # Here we figure out how many bits are set in each mask.
  my $RX = CountBits32($RMASK);
  my $GX = CountBits32($GMASK);
  my $BX = CountBits32($BMASK);
  my $AX = CountBits32($AMASK);

  # Here we figure out how much we have to shift a pixel's value
  # to the right in order to extract the individual R G B A values.
  my $RSHIFT = ZeroCountR32($RMASK) + ($RX > 8 ? $RX - 8 : 0);
  my $GSHIFT = ZeroCountR32($GMASK) + ($GX > 8 ? $GX - 8 : 0);
  my $BSHIFT = ZeroCountR32($BMASK) + ($BX > 8 ? $BX - 8 : 0);
  my $ASHIFT = ZeroCountR32($AMASK) + ($AX > 8 ? $AX - 8 : 0);

  # Here we build two separate lookup tables for
  # enhancing the R G B values and alpha:
  my $RLT = BuildColorStretchTable($RX);
  my $GLT = BuildColorStretchTable($GX);
  my $BLT = BuildColorStretchTable($BX);
  my $ALT = BuildColorStretchTable($AX);

  # Create canvas right here.
  my $CANVAS = sprintf('CANVAS%0.2d', $D << 3) . pack('NN', $W, $H);
  vec($CANVAS, $W * $H * $D + 15, 8) = 0;  # Fill canvas.
  my $P = 16;  # Canvas byte pointer to first pixel

  # Create 256 color palette if we have to downscale
  # the image to 8-bit from 16-bit, 24-bit, or 32-bit.
  if ($D == 1) {
    $PALWIDTH = 4;
    $PALETTE = Build256CPalette();
    $CANVAS .= $PALETTE;
  }

  # Open file for read only.
  local *FILE;
  sysopen(FILE, $F, 0) or return \$CANVAS;
  binmode FILE;
  for (my $Y = $START; $Y != $STOP; $Y += $DIR)
  {
    # Move the file pointer to the beginning of row $Y
    seek(FILE, $Y * $ROWLEN + $DATAPTR, 0);
    for (my $X = 0; $X < $W; $X++)
    {
      # Read one pixel:
      $PIXEL  = ord(getc(FILE));
      $PIXEL |= ord(getc(FILE)) << 8;
      $BPP <= 16 or $PIXEL |= ord(getc(FILE)) << 16;
      $BPP <= 24 or $PIXEL |= ord(getc(FILE)) << 24;

      # Extract R G B A values and do some color enhancement:
      $R = vec($RLT, ($RMASK & $PIXEL) >> $RSHIFT, 8);
      $G = vec($GLT, ($GMASK & $PIXEL) >> $GSHIFT, 8);
      $B = vec($BLT, ($BMASK & $PIXEL) >> $BSHIFT, 8);
      $A = vec($ALT, ($AMASK & $PIXEL) >> $ASHIFT, 8);

      # Write pixel to canvas:
      # If we have to save a 16-bit, 24-bit or 32-bit
      # pixel as 8-bit, then we convert it first.
      if ($D == 1) { vec($CANVAS, $P++, 8) =
        Match_Palette_Color($PALETTE, $R, $G, $B); }
      else # 24-bit or 32-bit:
      { $D < 4 or vec($CANVAS, $P++, 8) = $A;
        if ($D >= 3) { substr($CANVAS, $P, 3) =
          pack('CCC', $R, $G, $B); $P += 3; } }

      $PX++ < 10000 or $PX = print '.';
    }
  }
  close FILE;
  print "\nDONE.\n";
  return \$CANVAS;
}
##################################################
#                     BMP | Graphics | v2022.11.17
# This function expands RLE4 and RLE8 compressed BMP
# files and returns a reference to a canvas object.
# If an error occurs, then returns a reference
# to a blank (0x0) canvas.
#
# BMPINFO: The first argument must be a special string
# that is generated by the ReadBMPHeader() function.
#
# DEPTH: The second argument is the requested image depth
# for the canvas. This can be provided in bits per pixel or
# bytes per pixel. Valid values are: 1, 3, 4, 8, 24, 32.
# By default, all RLE compressed BMP images are 32-bit which
# includes transparency, but you may request 8-bit or 24-bit
# in which case the image will be downscaled automatically.
#
# Usage: CANVASREF = ExpandRLE(BMPINFO, DEPTH)
#
sub ExpandRLE
{
  my ($FMT, $E, $VFLIP, $PADDING, $BGRS, $PALWIDTH, $W, $H, $COMPR,
      $BMPVER, $COLORS, $XRES, $YRES, $MAXCOLORS, $FILESIZE,
      $DATASIZE, $DATAPTR, $RESERVED, $IC, $ROWLEN, $START, $STOP,
      $RMASK, $GMASK, $BMASK, $AMASK, $BPP, $SIG, $PLANES, $PALPTR,
      $CC, $DIR, $PALETTE, $F) = UnpackBMPINFO($_[0]);
  my $D = GetBPP(defined $_[1] ? $_[1] : $BPP);
  my $DEBUG = 0;

  print "\nExpanding $W x $H RLE compressed BMP image ",
        "($BPP bpp => ", ($D << 3), ' bpp) ';

  # Create canvas right here.
  my $CANVAS = sprintf('CANVAS%0.2d', $D << 3) . pack('NN', $W, $H);
  vec($CANVAS, $W * $H * $D + 15, 8) = 0;  # Fill canvas.
  if ($D == 1) { $CANVAS .= $PALETTE; }

  my $P = 16;            # Canvas byte pointer to first pixel
  my $PX = 0;
  $ROWLEN = $W * $D;     # Output bytes per row
  my ($X, $Y, $MODE, $COUNT, $REPEAT, $SKIP, $PIX1, $PIX2) = (0) x 9;

  # Initialize some variables.
  sysopen(FILE, $F, 0) or return \$CANVAS;
  binmode FILE;
  sysseek(FILE, $DATAPTR, 0);
  my $RUN = 1;
  while ($RUN)
  {
    $PX++ < 1000 or $PX = print '.';

    # Read file one byte at a time. Convert the byte to ASCII code.
    # After we reach the end of file, we read zeros.
    my $c = getc(FILE);
    $RUN = defined $c;
    $c = ($RUN) ? ord($c) : 0;

    if ($MODE < 0) { $MODE++; next; }   # Skip padding character.

    if ($MODE == 0)   # First byte
    {
      # If the first byte is zero: the next byte is going to be
      # a control character, which tells us what to do next...
      # If the first byte is non-zero: then we're looking at
      # a compressed chunk.
      $MODE = $c + 1;     # Remember this and read next byte.
      next;
    }
    if ($MODE == 1)   # 2nd byte: Control character!
    {
      if ($c == 0)       # END OF LINE.
      {
        $X = 0;
        $Y = IntRange($Y + 1, 0, $H);
        $P = $Y * $W * $D + 16;
        $MODE = 0;
        next;
      }
      elsif ($c == 1)    # END OF BITMAP.
        { last; }
      elsif ($c == 2)    # MOVE PEN.
        { $MODE = 300; next; }
      else               # Uncompressed block comes next
      {
        $COUNT = $c;
        $MODE = 500;

# Uncompressed blocks in RLE mode must end on a word boundary, so
# sometimes the block will be followed by a zero byte. We control
# this by setting the $SKIP value, which later sets $MODE to -1,
# which then causes the one byte to be read and discarded.
#
# Adobe PhotoShop and others include a padding byte when required,
# but XnView leaves the padding off in RLE4 mode. This means
# the resulting file will be smaller, but this is non-standard
# practice which prevents certain programs from decoding the
# file correctly. For example, Windows Paint will not open
# 16-color BMP files compressed with XnView. This discrepancy is
# hard to detect, but apparently, when $DATASIZE is zero, then
# no padding is added. So, in the next few lines we try to
# figure out when we need to skip a byte and when we don't:

        if ($BPP == 8) { $SKIP = $COUNT & 1; } else  # RLE8 padding
        { $SKIP = ($DATASIZE) ? ($COUNT & 2) : 0; }  # RLE4 padding
        next;
      }
    }
    elsif ($MODE <= 256)  # 2nd byte: Compressed data comes next
      { $COUNT = $MODE - 1; $MODE = 600; }
    elsif ($MODE == 300)  # Move pen. STEP 1.
    {
      $X += ($c < 128) ? $c : $c - 256;  # Update X coordinate
      $X = IntRange($X, 0, $W);
      $MODE = 330;  # Goto step 2 now.
      $DEBUG and print "\n\tMOVE PEN: X = $X";
      next;
    }
    elsif ($MODE == 330)  # Move pen. STEP 2.
    {
      $Y += ($c < 128) ? $c : $c - 256;  # Update Y coordinate
      $Y = IntRange($Y, 0, $H);
      $P = ($Y * $ROWLEN) + ($X * $D) + 16;  # Move pointer
      $MODE = 0;  # We're done.
      $DEBUG and print "\n\tMOVE PEN: Y = $Y";
      next;
    }

    if ($MODE > 400)   # Write pixel(s)
    {
      if ($MODE == 500)  # Prepare for writing uncompressed bytes.
      {
        $REPEAT = ($COUNT == 1 || $BPP == 8) ? 1 : 2;
        $COUNT -= ($BPP == 8) ? 1 : 2;
        if ($COUNT <= 0) { $MODE = ($SKIP) ? -1 : 0; $SKIP = 0; }
      }
      elsif ($MODE == 600)  # Prepare for repeating pixels
        { $REPEAT = $COUNT; $MODE = 0; }

      # In RLE8 mode, each byte ($c) holds the color of one pixel.
      # In RLE4 mode, each byte ($c) holds two pixels. First pixel
      # is in the upper 4 bits; the second is in the lower 4 bits.
      # We break this down into $PIX1 and $PIX2. Then in the
      # for loop below, we alternate between PIX1 and PIX2 as we
      # write the pixels one by one.
      if ($BPP == 4) { $PIX1 = ($c >> 4) & 15; $PIX2 = $c & 15; }

      for (my $i = 0; $i < $REPEAT; $i++)
      {
        if ($BPP == 4) { $c = ($i & 1) ? $PIX2 : $PIX1; }

        if ($Y < 0 || $Y >= $H) { last; }
        if ($X++ < 0 || $X > $W) { next; }

        if ($D == 1) {  # Write pixel to 8bpp canvas:
          vec($CANVAS, $P++, 8) = $c; }
        else {          # Write pixel to 24bpp canvas:
          my $A = vec($PALETTE, $c, 32);  # Lookup RGB values
          my $R = ($A >> 16) & 255;
          my $G = ($A >> 8) & 255;
          my $B = $A & 255;
          $A = ($A >> 24) & 255;
          if ($D == 4) { vec($CANVAS, $P++, 8) = $A; }  # 32bpp
          vec($CANVAS, $P++, 8) = $R;
          vec($CANVAS, $P++, 8) = $G;
          vec($CANVAS, $P++, 8) = $B;
        } #### End of write pixel
      } ###### End of repeat pixel
    } ######## End of $MODE select
  } ########## End of main loop
  close FILE;
  if ($VFLIP) { FlipVertical(\$CANVAS); }
  print "\nDONE.\n";
  return \$CANVAS;
}
##################################################
#                  Canvas | Graphics | v2022.11.21
# This function creates a new canvas object in
# memory and returns its reference.
#
# Usage: CANVASREF = NewCanvas(Width, Height, Depth, [BgColor])
#
sub NewCanvas
{
  my $W = IntRange($_[0], 0, 4294967295);  # Width
  my $H = IntRange($_[1], 0, 4294967295);  # Height
  my $D = GetBPP($_[2]);    # Depth
  my $C = Int32bit($_[3]);  # BgColor
  my $CANVAS = sprintf('CANVAS%0.2d', $D << 3) . pack('NN', $W, $H);
  my $LAST = $W * $H * $D + 15;
  vec($CANVAS, $LAST, 8) = 0;  # Reserve memory.
  if ($D == 3) { $C &= 0xffffff; }
  elsif ($D == 1) { $C &= 255; }
  $C or return \$CANVAS;  # Canvas is already painted black.
  if ($D == 1) { $C = chr($C); }
  else { $C = pack('N', $C);
    if ($D == 3) { $C = substr($C, 1, 3); } }
  for (my $P = 16; $P <= $LAST; $P += $D)   # Paint canvas.
    { substr($CANVAS, $P, $D) = $C; }
  return \$CANVAS;
}
##################################################
#                           Graphics | v2022.11.20
# This function creates a lookup table for color
# enhancement. The function expects one integer
# that tells it how many bits are used to
# represent a particular RGB channel.
#
# Usage: STRING = BuildColorStretchTable(BITCOUNT)
#
sub BuildColorStretchTable
{
  my $N = $_[0];
  $N > 0 or return '';

  # What's the biggest number we can arrange using $N number of bits?
  my $MAX = (1 << $N) - 1;

  my $LUT = '';
  vec($LUT, $MAX, 8) = 0;  # Reserve memory for the lookup table.

  # If colors are represented with 8 bits, then we don't
  # need to stretch anything at all. In other words,
  # the output is going to be the same as the input.
  # So, here we build a lookup table that does that:
  if ($N >= 8)
  {
    for (my $i = 1; $i < 256; $i++)
      { vec($LUT, $i, 8) = $i; }
    return $LUT;
  }

  # Calculate multiplier.
  my $MULTIPLIER = 255 / $MAX;

  # Here, we will build the lookup table:
  for (my $i = 1; $i <= $MAX; $i++)
    { vec($LUT, $i, 8) = ($i * $MULTIPLIER) & 255; }
  return $LUT;
}
##################################################
#                             Palette | v2022.9.27
# This function returns a color index that points
# to a palette color that is the closest match to
# the original R G B values provided. This function
# is used when downscaling a truecolor bitmap from
# 16 million colors to 16 colors or 256 colors, and for
# each RGB pixel, we must find a color in the palette
# that most closely resembles the original color.
#
# NOTE: No error checking is done, so make sure you
# pass the right arguments every time!
#
# Usage: COLOR_INDEX = Match_Palette_Color(PALETTE, R, G, B)
#
sub Match_Palette_Color
{
  my ($i, $C, $PREV, $DIFF, $PALPTR) = (0) x 5;
  my $L = length($_[0]);
  my $LEAST_DIFF = 777;

  for (; $PALPTR < $L; $PALPTR += 4, $i++)
  {
    $DIFF = abs(vec($_[0], $PALPTR + 1, 8) - $_[1])
          + abs(vec($_[0], $PALPTR + 2, 8) - $_[2])
          + abs(vec($_[0], $PALPTR + 3, 8) - $_[3]);
    if ($DIFF == 0) { return $i; }
    if ($DIFF < $LEAST_DIFF) {
      $LEAST_DIFF = $DIFF;
      $PREV = $C;
      $C = $i;
    }
  }
  return $C;
}
##################################################
#                     BMP | Graphics | v2022.11.21
# This function returns all the values that are
# stored in the BMPINFO string.
# Usage: ARRAY = UnpackBMPINFO(BMPINFO)
#
sub UnpackBMPINFO
{
  defined $_[0] && length($_[0]) > 1122 or return ();
  my @L = unpack('C6V20v5c', $_[0]);
  push(@L, substr($_[0], 98, 1024));
  push(@L, substr($_[0], 1123));
  return @L;
}
##################################################
#                            Graphics | v2022.11.5
# This function returns a complete BMP file header
# which is usually between 50 and 1100 bytes long.
# Returns an empty string if something goes wrong.
#
# Usage: HEADER = MakeBMPHeader(WIDTH, HEIGHT, BPP,
#    COMPR, BMPVER, DATASIZE, COLORS, IC, PALETTE,
#                  DPI, AMASK, RMASK, GMASK, BMASK)
#
sub MakeBMPHeader
{
  @_ >= 5 or return '';
  my ($W, $H, $BPP, $COMPR, $BMPVER, $DATASIZE, $COLORS, $IC,
           $PALETTE, $DPI, $AMASK, $RMASK, $GMASK, $BMASK) = @_;

  # Fix some errors.
  $BMPVER = NearestNum($BMPVER, 12, 16, 40, 52, 56, 64, 108, 124);
  my $PALMAX = ($BMPVER < 16) ? 768 : 1024;
  if (length($PALETTE) > $PALMAX)
    { $PALETTE = substr($PALETTE, 0, $PALMAX); }

  # Check limitations.
  if ($BMPVER < 40 && ($W > 65535 || $H > 65535)) { $BMPVER = 40; }
  if ($W > 4294967295) {
    print "\nBMP image width cannot exceed 4,294,967,295 pixels!\n";
    return ''; }
  if ($H > 2147483647) {
    print "\nBMP image height cannot exceed 2,147,483,647 pixels!\n";
    return ''; }

  # Colors and Important Colors (IC) have significance when we're
  # working with color-indexed images. A zero value means
  # that all colors are used and all colors are important.
  # In most BMP files, both COLORS and IC are zero.
  my $MAXCOLORS = GetMaxColors($BPP);
  FixOverflow($COLORS, $MAXCOLORS, 0);
  FixOverflow($IC, $MAXCOLORS, 0);

  # It is okay for DATASIZE and FILESIZE to be zero,
  # because most programs ignore these values anyway.
  # (When DATASIZE is zero, it has a special meaning, but
  # that only comes into play when using RLE compression.)
  my $HDRSIZE = 14 + $BMPVER + length($PALETTE);
  my $FILESIZE = $HDRSIZE + $DATASIZE;
  FixOverflow($DATASIZE, 4294967295, 0);
  FixOverflow($FILESIZE, 4294967295, 0);

  # XRES and YRES hold the recommended print resolution.
  # (It's perfectly fine to leave these values zero.)
  my $XRES = int($DPI * 3.934);
  my $YRES = int($DPI * 3.934);

  # Assemble BMP Header.
  my $HEADER = 'BM' . pack(($BMPVER < 16 ? 'V4v4' : 'V6vv'),
    $FILESIZE, 0, $HDRSIZE, $BMPVER, $W, $H, 1, $BPP);
  if ($BMPVER > 16) { $HEADER .= pack('V6', $COMPR,
    $DATASIZE, $XRES, $YRES, $COLORS, $IC); }
  if ($BPP >= 16 && $COMPR == 3 && $BMPVER >= 56 && $HDRSIZE >= 70)
    { $HEADER .= pack('V4', $RMASK, $GMASK, $BMASK, $AMASK); }
  elsif ($BPP <= 8) { if ($BMPVER >= 108) { $HEADER .= 'BGRs'; }
    $HEADER .= $PALETTE; }
  if (length($HEADER) < $HDRSIZE) { $HEADER .= "\0" x
    ($HDRSIZE - length($HEADER)); }  # Fill the rest with zeros.
  return $HEADER;
}
##################################################
#                      BMP | Graphics | v2022.11.5
# This function converts canvas image data to
# standard 24-bit truecolor BMP format and saves
# it to a file. This is the most popular BMP format.
# It is recognized by most photo viewers and editors.
#
# Usage: STATUS = SaveBMP24(CANVASREF, FILENAME)
#
sub SaveBMP24
{
  my ($CANVAS, $W, $H, $INPUT, $PTR) = UseCanvas($_[0]) or return 0;
  my $FILENAME = FilterFileName($_[1]);

  print
    "\nSaving BMP file: $FILENAME",
    "\nin standard truecolor format: $W x $H  (", ($INPUT << 3), " bpp
+ => 24 bpp) ...";

  # Padding is used to make EACH LINE'S LENGTH divisible by 4.
  # So, we extend the lines (when we have to) by adding zero bytes
  # at the end of every line. Note: The fastest way to divide the
  # image width by 4 and get the remainder is to do: ($W & 3)
  my $ROWLEN = $W * 3;
  my $PADLEN = (4 - ($ROWLEN & 3)) & 3;
  my $PADDING = "\0" x $PADLEN;
  my $DATASIZE = ($ROWLEN + $PADLEN) * $H;
  my $HEADER = 
       MakeBMPHeader($W, $H, 24, 0, 40, $DATASIZE, 0, 0, '', 720)
         or return 0;

  my $PALETTE = GetCanvasPalette($CANVAS);
  if (length($PALETTE) == 0) { $PALETTE = Build256CPalette(); }

  local *FILE;
  open(FILE, ">$FILENAME") or return 0;   # Create a BMP file.
  binmode FILE;
  print FILE $HEADER;   # Write BMP header.
  undef $HEADER;        # Erase header from memory.

  my ($PX, $R, $G, $B) = (0) x 4;
  my $CANVAS_ROWLEN = $W * $INPUT;     # Canvas bytes per row
  my $P = $CANVAS_ROWLEN * $H + $PTR;  # Canvas byte pointer
  # $P is now pointing to the last pixel in the canvas (bottom right)

  # BMP files usually contain images upside down,
  # so we start from the bottom and go up.
  for (my $Y = $H - 1; $Y >= 0; $Y--)
  {
    $P -= $CANVAS_ROWLEN;  # Jump to the beginning of the line.
    for (my $X = 0; $X < $W; $X++)
    {
      if ($INPUT == 1)
      # If we're getting only 1 byte per pixel, then we have to
      # use a palette to look up the R G B values:
      {
        my $CX = vec($$CANVAS, $P++, 8) << 2;
        $R = vec($PALETTE, $CX + 1, 8);
        $G = vec($PALETTE, $CX + 2, 8);
        $B = vec($PALETTE, $CX + 3, 8);
      }
      # If we're getting 4 bytes per pixel, we discard the alpha:
      else { $INPUT == 4 and $P++;
        # We're getting 3 byte-per-pixel signal:
        $R = vec($$CANVAS, $P++, 8);
        $G = vec($$CANVAS, $P++, 8);
        $B = vec($$CANVAS, $P++, 8);
      }
      print FILE  pack('CCC', $B, $G, $R);   # Write pixel
      $PX++ < 10000 or $PX = print '.';
    }
    if ($PADLEN) { print FILE $PADDING; }    # Insert padding
    $P -= $CANVAS_ROWLEN;  # Go one line up.
  }
  close FILE;
  print "\nDONE.\n";
  return 1;
}
##################################################
#                              String | v2022.11.9
# This function can be used to test if a scalar is
# a reference to a string that holds some value.
# If this condition is true, returns the reference,
# otherwise returns zero.
# Usage: REF = GetRef(REF)
#
sub GetRef
{
  defined $_[0] or return 0;
  ref($_[0]) eq 'SCALAR' or return 0;
  my $REF = $_[0];
  return (defined $$REF && length($$REF)) ? $REF : 0;
}
##################################################
#                  Graphics : Palette | v2022.11.9
# This function adds a color palette to the canvas.
# Usage: SetCanvasPalette(CANVASREF, PALETTE)
#
sub SetCanvasPalette
{
  defined $_[1] && length($_[1]) > 4 or return 0;
  SetCanvasTail($_[0], $_[1]);
}
##################################################
#                  Graphics : Palette | v2022.11.9
# Returns the color palette from the canvas string.
# Usage: PALETTE = GetCanvasPalette(CANVASREF)
#
sub GetCanvasPalette
{
  my $T = GetCanvasTail($_[0]);
  length($T) >= 1024 or return '';
  return substr($T, 0, 1024);
}
##################################################
#                            Graphics | v2022.11.7
# Returns 1 if the first argument holds a reference
# to a valid canvas string; returns zero otherwise.
# Usage: INTEGER = IsCanvasRef(CANVASREF)
#
sub IsCanvasRef
{
  my $REF = GetRef($_[0]) or return 0;
  length($$REF) > 15 or return 0;
  my $S = substr($$REF, 0, 8);
  return ($S eq 'CANVAS32' | $S eq 'CANVAS24' | $S eq 'CANVAS08');
}
##################################################
#                  Canvas | Graphics | v2022.11.22
# This function returns whatever additional data is
# stored at the end of the canvas string that is not
# part of the pixel data.
# Usage: STRING = GetCanvasTail(CANVASREF)
#
sub GetCanvasTail
{
  my ($CANVAS, $W, $H, $D, $START) = UseCanvas($_[0]) or return '';
  my $IMAGESIZE = $W * $H * $D + $START;
  return (length($$CANVAS) > $IMAGESIZE) ?
    substr($$CANVAS, $IMAGESIZE) : '';
}
##################################################
#                  Canvas | Graphics | v2022.11.22
# This function adds additional data to the end
# of a canvas string. This can be a color palette or
# some plain text description about the image.
# Usage: SetCanvasTail(CANVASREF, STRING)
#
sub SetCanvasTail
{
  my ($CANVAS, $W, $H, $D, $START) = UseCanvas($_[0]) or return 0;
  my $T = defined $_[1] ? $_[1] : '';
  my $LT = length($T);
  my $IMAGESIZE = $W * $H * $D + $START;

  # Expand canvas size if it's too small.
  if (length($$CANVAS) < $IMAGESIZE)
    { vec($$CANVAS, $IMAGESIZE - 1, 8) = 0; }

  # Write tail data.
  substr($$CANVAS, $IMAGESIZE, $LT) = $T;

  # Reduce canvas size if it's too big.
  if (length($$CANVAS) > $IMAGESIZE + $LT)
    { $$CANVAS = substr($$CANVAS, 0, $IMAGESIZE + $LT); }

  return 1;
}
##################################################
#                  Canvas | Graphics | v2022.11.13
# This function converts the image depth to
# bytes per pixel. It doesn't matter if you provide
# the depth in bits per pixel or bytes per pixel.
# This function always returns it in bytes per pixel.
# Returns 3 if an invalid value is provided!
#
# Usage: BYTES_PER_PIXEL = GetBPP(DEPTH)
#
sub GetBPP
{
  my $D = IntRange($_[0], 0, 999);
  if ($D == 1 || $D == 8) { return 1; }
  elsif ($D == 4 || $D == 32) { return 4; }
  return 3;
}
##################################################
#                   Canvas | Graphics | v2022.11.7
# This function erases the canvas and fills it with
# one solid color.
#
# The COLOR must be specified as an integer which
# holds an 8-bit, 24-bit, or 32-bit value. If it's
# a 32-bit value, it must be given as 0xAARRGGBB.
# If it's a 24-bit value, it must be given as 0xRRGGBB.
#
# Usage: FillCanvas(CANVASREF, COLOR)
#
sub FillCanvas
{
  my $REF = GetCanvasRef($_[0]) or return 0;  # Check reference
  my $COLOR = Int32bit($_[1]);      # Color is a 32-bit integer
  my $TAIL = GetCanvasTail($REF);   # Save palette and plain text.
  my $W = WidthOf($REF);   # Get image width in pixels
  my $H = HeightOf($REF);  # Get image height in pixels
  my $D = DepthOf($REF);
  my $SIZE = $W * $H * $D + 16;
  $$REF = substr($$REF, 0, 16);  # Erase canvas.
  vec($$REF, $SIZE - 1, 8) = 0;  # Fill with black.
  if ($COLOR)
  {
    if ($D == 1)
    {
      $COLOR &= 255;
      for (my $i = 16; $i < $SIZE; $i++)
      { vec($$REF, $i, 8) = $COLOR; }
    }
    if ($D == 3)
    {
      $COLOR = substr(pack('N', $COLOR & 0xffffff), 1, 3);
      for (my $i = 16; $i < $SIZE; $i += 3)
      { substr($$REF, $i, 3) = $COLOR; }
    }
    if ($D == 4)
    {
      $SIZE = $W * $H + 4;
      for (my $i = 4; $i < $SIZE; $i++)
      { vec($$REF, $i, 32) = $COLOR; }
    }
  }
  length($TAIL) and SetCanvasTail($REF, $TAIL);
  return 1;
}
##################################################
#                     BMP | Graphics | v2022.11.17
# This function reads the color palette from a
# BMP file's header and returns it as a 1024-byte
# string in which each color takes up 4 bytes,
# starting with alpha (transparency) value, which
# is followed by the red, green, and blue values.
# Missing colors are filled with zero bytes.
#
# The 1st argument (HEADER) must be a string that
# contains the first 1200 bytes of a BMP file.
# The 2nd argument (PALPTR) is a pointer to where
# the palette begins within the header.
# The 3rd argument (PALWIDTH) tells the function
# whether the palette is 3 or 4 bytes per color.
# The 4th argument (CC) is the number of colors
# in the palette.
#
# Usage: PALETTE = ReadBMPPalette(HEADER, PALPTR, PALWIDTH, CC)
#
sub ReadBMPPalette
{
  @_ == 4 or return '';
  foreach (@_) { defined $_ or return ''; }
  my $PALPTR   = $_[1];
  my $PALWIDTH = $_[2];
  my $CC       = $_[3];
  $PALPTR > 12 or return '';

  # Initialize palette.
  my $PALETTE = '';
  vec($PALETTE, 1023, 8) = 0;  # Fill with zero bytes.
  my ($R, $G, $B, $A) = (0) x 4;

  # In the BMP header, each color is stored usually in 4 bytes,
  # sometimes 3 bytes. And they are stored first starting with
  # the blue value, then green, red, and finally the alpha.
  for (my $i = 0; $i < $CC; $i++)
  {
    $B = vec($_[0], $PALPTR++, 8);
    $G = vec($_[0], $PALPTR++, 8);
    $R = vec($_[0], $PALPTR++, 8);
    $A = vec($_[0], $PALPTR++, 8) if ($PALWIDTH == 4);
    vec($PALETTE, $i, 32) = $A << 24 | $R << 16 | $G << 8 | $B;
  }
  return $PALETTE;
}
##################################################
#                           Graphics | v2022.10.29
# This function converts an RGB color to the SHORTEST
# string representation of that color for use in a
# HTML document.
#
# Example: Color2HTML('ffffff') => 'white'
#
# A THRESHOLD value tells this function that if a color
# is close enough to a nearby color that can be expressed
# in fewer bytes, then go with that color instead. For
# example, if THRESHOLD is 5, then the color 0xfe0103
# is close enough to 0xff0000 which can be expressed
# simply as 'RED' in a HTML document. "<FONT COLOR=RED>"
# is a valid expression, and so is "<FONT COLOR=FE0103>"
# but the first one is 3 bytes shorter.
#
# It's easier to tell the difference between two bright
# colors than two dark colors, so there are two different
# values for threshold-- one is for dark colors,
# and the other is for light colors.
#
# Default value: Color2HTML($HEXCOLOR, 80, 8);
#
# Usage: STRING = Color2HTML(HEXCOLOR, [DARK_THRESHOLD, LIGHT_THRESHOL
+D])
#
sub Color2HTML
{
  my $C = defined $_[0] ? $_[0] : '000000';
  my $R = hex(substr($C, 0, 2));
  my $G = hex(substr($C, 2, 2));
  my $B = hex(substr($C, 4, 2));
  my $LO = defined $_[1] ? $_[1] : 25;
  my $HI = defined $_[2] ? 255 - $_[2] : 247;
  if ($R < $LO && $G < $LO && $B < $LO) { return '0'; }
  if ($R > $HI && $G > $HI && $B > $HI) { return 'WHITE'; }
  if ($R > $HI && $G < $LO && $B < $LO) { return 'F#'; }
  if ($R < $LO && $G < $LO && $B > $HI) { return 'BLUE'; }
  if ($R < $LO && $G > $HI && $B < $LO) { return '00F#'; }
  if ($R < $LO && $G > $HI && $B > $HI) { return 'CYAN'; }
  if ($R > $LO && $G < $LO && $B < $LO) { return substr($C, 0, 1) . '#
+'; }
  if ($B < $LO)
  {
    $G = ($G & 0xF0) + (($G & 15) < 9 ? 0 : 16);
    $G < 255 or $G = 255;
    return sprintf('%0.2X%X#', $R, $G >> 4);
  }
  if ($R > $LO && $G > $LO && $B < $LO) { return substr($C, 0, 3) . '#
+'; }
  if ($B < $LO) { return substr($C, 0, 4) . '#'; }
  return $C;
}
##################################################
#                           Graphics | v2022.10.29
# This function writes <TD> tags that appear as one
# or more pixels when displayed in a web browser.
#
# Usage: STRING = HTMLWritePixel(BGCOLOR, COLOR, REPEAT)
#
sub HTMLWritePixel
{
  my ($BGCOLOR, $COLOR, $REPEAT) = @_;
  return (($REPEAT == 1) ? '<TD' : "<TD COLSPAN=$REPEAT") . (($BGCOLOR
+ eq $COLOR) ? '' : (' BGCOLOR=' . Color2HTML($COLOR))) . '>';
}
##################################################
#                           Graphics | v2022.10.29
# This function exports a canvas image to a HTML
# <TABLE> object where each pixel becomes an
# individual <TD> element...
#
# Usage: HTMLCODE = Canvas2HTML(CANVASREF)
#
sub Canvas2HTML
{
  my ($REF, $W, $H, $INPUT, $PTR) = UseCanvas($_[0], 24) or return '';
  my $BGCOLOR = sprintf('%0.6X', FindDominantColor($REF));
  my $HTML = "<TABLE WIDTH=$W HEIGHT=" . int($H * 2) . ' BGCOLOR=' . C
+olor2HTML($BGCOLOR) . ' CELLSPACING=0 CELLPADDING=1>';
  print "\nConverting canvas image to HTML code...";
  if ($INPUT == 4) { $PTR++; }
  for (my $Y = 0; $Y < $H; $Y++)
  {
    my $PREV = '';
    my $WRITE = '';
    my $REPEAT = 0;
    $HTML .= '<TR>';
    for (my $X = 0; $X < $W; $X++)
    {
      my ($R, $G, $B) = unpack('CCC', substr($$REF, $PTR, $INPUT));
      my $COLOR = sprintf('%0.2X%0.2X%0.2X', $R, $G, $B);
      if ($PREV eq $COLOR) { $REPEAT++; $WRITE = ''; }
      else {
        if ($REPEAT++) { $HTML .= HTMLWritePixel($BGCOLOR, $PREV, $REP
+EAT); $WRITE = ''; }
        if (length($WRITE)) { $HTML .= $WRITE; }
        $WRITE = HTMLWritePixel($BGCOLOR, $COLOR, 1);
        $REPEAT = 0;
      }
      $PREV = $COLOR;
      $PTR += 3;
    }
    if ($REPEAT++) { $HTML .= HTMLWritePixel($BGCOLOR, $PREV, $REPEAT)
+; }
    $HTML .= $WRITE;
    $Y & 31 or print '.';
  }
  $HTML .= '</TABLE>';
  print "\nDONE.\n";
  return $HTML;
}
##################################################
#                   Canvas | Graphics | v2022.11.3
# Returns a reference to a 0 x 0 pixel blank canvas
# when given one number (depth), OR when given a
# canvas reference, it deletes the canvas and resets
# it to a 0 x 0 image.
#
# Usage: CANVASREF = BlankCanvas([CANVASREF] | [DEPTH])
#
sub BlankCanvas
{
  my $REF = GetRef($_[0]) or return NewCanvas(0, 0, $_[0]);
  $$REF = 'CANVAS' . sprintf('%0.2d', GetBPP($_[0]) << 3) . "\0" x 8;
  return $REF;
}
##################################################
#                   Graphics : Canvas | v2022.11.9
# This function returns a reference to a canvas object
# along with its width, height and depth...
# Returns an empty list if the canvas object is
# missing or corrupt or if it has a different
# format than what's requested.
#
# Usage: ARRAY = UseCanvas(CANVASREF, [REQUESTS])
#
# The following values are returned on success:
#  ARRAY[0] = Reference to the canvas object
#  ARRAY[1] = Image width in pixels
#  ARRAY[2] = Image height in pixels
#  ARRAY[3] = Image depth (bytes per pixel)
#  ARRAY[4] = Byte Pointer to where pixel data begins
#
# "REQUESTS" is a list of optional arguments (numbers) that
# tell this function to return a canvas reference only if
# the canvas image depth matches one of these values. See
# example below.
#
# @LIST = UseCanvas($CANVAS, 32, 24) or return 0;
#
# The above example will returns a list of items IF
# $CANVAS is a reference to a valid 24-bit-per-pixel
# image or a 32-bit-per-pixel image. Otherwise returns
# an empty list.
#
# The following example returns a list of items IF
# $CANVAS is a reference to a valid canvas image
# of any depth:
#
# @LIST = UseCanvas($CANVAS) or return 0;
#
sub UseCanvas
{
  my $REF = GetCanvasRef($_[0]) or return ();
  my $D = DepthOf($REF);
  shift;
  foreach (@_)
  {
    if (($_ == 32 || $_ == 4) && $D == 4) { $D = 4; last; }
    if (($_ == 24 || $_ == 3) && $D == 3) { $D = 3; last; }
    if (($D == 8) && ($_ == 8 || $_ == 1))
    { $D = 1; last; } else { $D = 0; }
  }
  $D or return ();

  # Check canvas size.
  FixCanvas($REF);
  my $W = WidthOf($REF);
  my $H = HeightOf($REF);
  return ($REF, $W, $H, $D, 16);
}
##################################################
#                           Graphics | v2022.10.18
# This function returns a canvas reference if the
# first argument holds a valid canvas reference.
# Otherwise this function returns zero!
#
# Usage: CANVASREF = GetCanvasRef(CANVAS OR CANVASREF)
#
sub GetCanvasRef
{
  defined $_[0] or return 0;
  ref($_[0]) eq 'SCALAR' or return 0;
  return IsCanvasRef($_[0]) ? $_[0] : 0;
}
##################################################
#                           Graphics | v2022.10.29
# This function converts a truecolor image to
# web-safe colors using a 256-byte lookup table.
#
# Usage: ConvertToWebColors(CANVASREF)
#
sub ConvertToWebColors
{
  my ($REF, $W, $H, $D, $P) = UseCanvas($_[0]) or return 0;
  print "\nConverting $W x $H image to web safe colors...";

  # Create lookup table.
  my $LUT = '';
  for (my $i = 0; $i < 25; $i++) { $LUT .= "\x00"; }
  for (my $i = 0; $i < 50; $i++) { $LUT .= "\x33"; }
  for (my $i = 0; $i < 50; $i++) { $LUT .= "\x66"; }
  for (my $i = 0; $i < 50; $i++) { $LUT .= "\x99"; }
  for (my $i = 0; $i < 50; $i++) { $LUT .= "\xCC"; }
  for (my $i = 0; $i < 25; $i++) { $LUT .= "\xFF"; }

  if ($D == 1)
  {
    my $PAL = GetCanvasPalette($REF);
    if (length($PAL))
    {
      my $PALWIDTH = (length($PAL) == 1024) ? 4 : 3;
      my $COLORS = int(length($PAL) / $PALWIDTH);
      my $P = 0;
      for (my $i = 0; $i < $COLORS; $i++)
      {
        if ($PALWIDTH == 4) { $P++; }
        # Read R G B values and look up the appropriate safe color
        # from the lookup table and write it back to the palette:
        vec($PAL, $P, 8) = vec($LUT, (vec($PAL, $P, 8)), 8); $P++;
        vec($PAL, $P, 8) = vec($LUT, (vec($PAL, $P, 8)), 8); $P++;
        vec($PAL, $P, 8) = vec($LUT, (vec($PAL, $P, 8)), 8); $P++;
      }
      SetCanvasPalette($REF, $PAL);
    }
    return 1;
  }

  # Go through the whole image pixel by pixel...
  my $RES = $W * $H;
  for (my $i = 0; $i < $RES; $i++, $P += 3)
  {
    if ($D == 4) { $P++; }  # Skip alpha value in 32bpp images
    # Read R G B values and look up the appropriate safe color
    # from the lookup table and write it back to the image:
    vec($$REF, $P, 8) = vec($LUT, vec($$REF, $P, 8), 8); $P++;
    vec($$REF, $P, 8) = vec($LUT, vec($$REF, $P, 8), 8); $P++;
    vec($$REF, $P, 8) = vec($LUT, vec($$REF, $P, 8), 8); $P++;
    if (($i & 0xfffff) == 0) { print '.'; }
  }
  undef $LUT;
  return 1;
}
##################################################
#                           Graphics | v2022.10.29
# This function analyzes an image and returns the
# color that is most often used in that image.
#
# For example, if yellow is the most dominant color
# in an image, then this function returns 0xFFFF00
#
# The image object must be passed by reference!
#
# Usage: INTEGER = FindDominantColor(CANVASREF)
#
sub FindDominantColor
{
  my ($CANVAS, $W, $H, $PTR, $RES) = UseCanvas($_[0], 24) or return 0;
  print "\nAnalyzing ", Commify($RES),
    ' pixels to find the dominant color of the image...';

  # Now we will count how many times each color is used. First, we
  # create a giant score board. There are 16,777,216 possible colors
  # in a modern truecolor image, and we will use a 4-byte integer to
  # keep count of every color. That's 4 x 16,777,216 bytes.
  # So, first, we fill the scoreboard with zero bytes,
  # and then we start counting the colors.
  my $C = '';
  vec($C, 67108863, 8) = 0;

  # We can stop counting if a color covers more than half
  my $STOP = int($RES / 2) + 1;   # of the entire image.

  # We must also stop counting if a color occurs more than 4 billion
  # times, because if we keep counting, the 4-byte integers that
  # we use to count the colors can overflow, and we don't want that.
  # This limitation means that if you have an image that is
  # 100,000 x 100,000 pixels or greater, then this function
  # will not give you an accurate result every time.
  if ($STOP > 0xffffffff) { $STOP = 0xffffffff; }

  my $TOPCOUNT = 0;
  my $DOMINANT = 0;
  for (my $i = 0; $i < $RES; $i++, $PTR += 3)
  {
    # Read pixel:
    my $RGB = vec(substr($$CANVAS, $PTR, 3), 0, 32) >> 8;
    
    # Increment count:
    my $COUNT = vec($C, $RGB, 32) = vec($C, $RGB, 32) + 1;

    if ($COUNT > $TOPCOUNT)
    {
      $DOMINANT = $RGB;    # Keep track of the most dominant color
      $TOPCOUNT = $COUNT;  # Remember how many times it was used
      # If at least half of the image is made up of one single color
      # or we reach 0xffffffff, then we stop counting.
      if ($TOPCOUNT >= $STOP) { last; }
    }
    if (($i & 0xfffff) == 0) { print '.'; }
  }
  printf("\n  The dominant color is: %0.6X\n", $DOMINANT);
  return $DOMINANT;
}
##################################################
#                                        v2022.9.5
# This function removes illegal characters from
# a file name such as:  $ % ? * < > | " \t \r \n \0
# and any character whose ASCII value is 0-31.
#
# Usage: FILENAME = FilterFileName(FILENAME)
#
sub FilterFileName
{
  my $F = defined $_[0] ? $_[0] : '';
  $F =~ tr`<>*%$?\x00-\x1F\"\|``d;
  return $F;
}
##################################################
#                               Math | v2022.11.19
# This function converts a 32-bit integer to a
# binary number that consists of 1s and 0s, and
# counts the number of zeroes that are at the end
# of the number. (Actually, we use a lookup table
# to speed things up a bit...)
#
# Example: ZeroCountR32(1500000) => 5
#
#  1500000 = 00000000000101101110001101100000
#                                       ^^^^^
#                                         5
# Usage: COUNT = ZeroCountR32(INTEGER)
#
sub ZeroCountR32
{
  my $N = $_[0] & 0xffffffff;
  $N or return 32;
  my $HI = ZeroCountR16($N >> 16);
  my $LO = ZeroCountR16($N);
  return ($LO < 16) ? $LO : $HI + 16;
}
##################################################
#                               Math | v2022.11.19
# This function converts an integer (0-65535) to a
# 16-digit number that consists of 1s and 0s, and
# counts the number of zeroes that are on the right
# side of that number. (Actually, we use a lookup
# table to speed things up a bit.)
#
# Example: ZeroCountR16(696) => 3
#
#    696 = 0000001010111000
#                       ^^^
#                        3
#
# Usage: COUNT = ZeroCountR16(INTEGER)
#
sub ZeroCountR16
{
  defined $_[0] or return 16;
  my $N = $_[0] & 0xffff;
  $N or return 16;  # Let me guess...it's zero?
  my @HI = ZeroCount8($N >> 8);
  my @LO = ZeroCount8($N);
  return ($LO[1] < 8) ? $LO[1] : $HI[1] + 8;
}
##################################################
#                               Math | v2022.11.19
# This function converts an integer (0-255) to an
# 8-digit number that consists of 1s and 0s, and
# counts the number of zeroes that come before
# and after the number. (Actually, we use a
# lookup table to speed things up a bit.)
#
# Example: ZeroCount8(40) => (2, 3)
#
#   40 = 00101000
#        ^^   ^^^
#         2    3
#
# The second and third arguments are optional:
# The second argument will be added to BEFORE's value.
# The third argument will be added to AFTER's value.
#
# Usage: (BEFORE, AFTER) = ZeroCount8(INTEGER, [ADD1, [ADD2]])
#
sub ZeroCount8
{
  # DO NOT MODIFY LOOKUP TABLE:
  my $N = vec("\xB0\xA8\x97\x98\x86\x88\x87\x88uxwxvxwxdhghfhghehghfhg
+hSXWXVXWXUXWXVXWXTXWXVXWXUXWXVXWXBHGHFHGHEHGHFHGHDHGHFHGHEHGHFHGHCHGH
+FHGHEHGHFHGHDHGHFHGHEHGHFHGH18786878587868784878687858786878387868785
+878687848786878587868782878687858786878487868785878687838786878587868
+784878687858786878", $_[0] & 255, 8);
  my $BEFORE = ($N >> 4) + (defined $_[1] ? $_[1] : 0) - 3;
  my $AFTER = (8 - ($N & 15)) + (defined $_[2] ? $_[2] : 0);
  return ($BEFORE, $AFTER);
}
##################################################
#                               Math | v2022.10.21
# This function counts how many 1s occur in a
# 32-bit integer when converted to binary format.
# (This function actually doesn't do any counting;
# it uses a lookup table to get the answer.)
#
# Usage: INTEGER = CountBits32(INTEGER)
#
sub CountBits32
{
  my $V = $_[0] & 0xffffffff;
  my $T = "\x10!!2!22C!22C2CCT!22C2CCT2CCTCTTe!22C2CCT2CCTCTTe2CCTCTTe
+CTTeTeev!22C2CCT2CCTCTTe2CCTCTTeCTTeTeev2CCTCTTeCTTeTeevCTTeTeevTeeve
+vv\x87";
  # According to the order of precedence, the shift >> operator is eva
+luated first,
  # then the bitwise & operator is second, which is quite convenient f
+or us here.
  return vec($T, $V & 255, 4) + vec($T, $V >> 8 & 255, 4) + vec($T, $V
+ >> 16 & 255, 4) + vec($T, $V >> 24 & 255, 4);
}
##################################################
#                           Graphics | v2022.11.14
# This function flips an image vertically.
# Supports 8-bit, 24-bit and 32-bit images.
#
# Usage: STATUS = FlipVertical(CANVASREF)
#
sub FlipVertical
{
  my ($REF, $W, $H, $D, $START) = UseCanvas($_[0]) or return 0;

  # If the entire image is just one line, there is nothing to do.
  $W > 0 && $H > 1 or return 1;

  my $COUNT = $H >> 1;
  my $ROWLEN = $W * $D;
  my $FROM = $START;
  my $TO = $ROWLEN * $H + $START;
  while ($COUNT--)
  {
    $TO -= $ROWLEN;
    my $LINE = substr($$REF, $FROM, $ROWLEN);  # Copy entire line
    substr($$REF, $FROM, $ROWLEN) = substr($$REF, $TO, $ROWLEN);
    substr($$REF, $TO, $ROWLEN) = $LINE;
    $FROM += $ROWLEN;
  }
  return 1;
}
##################################################
#                 Palette | Graphics | v2022.11.19
# This function builds a 256-color palette
# that somewhat resembles web colors.
# Returns a string that contains 256 x 4 bytes.
# The 4-byte chunks correspond to A R G B values.
# The alpha value is always zero.
#
# Usage: STRING = Build256CPalette()
#
sub Build256CPalette
{
  my $PALETTE = '';
  foreach (0, 0x33, 0x66, 0x99, 0xCC, 0xE8, 0xFF)
  {
    my $RED = chr($_);
    foreach (0, 0x33, 0x66, 0x99, 0xCC, 0xFF)
    {
      my $GREEN = chr($_);
      foreach (0, 0x33, 0x66, 0x99, 0xCC, 0xFF)
      { $PALETTE .= "\0" . $RED . $GREEN . chr($_); }
    }
  }
  $PALETTE .= "\0" . ("\xE5" x 3);
  $PALETTE .= "\0" . ("\xB5" x 3);
  $PALETTE .= "\0" . ("\x80" x 3);
  $PALETTE .= "\0" . ("\x4C" x 3);
  return $PALETTE;
}
##################################################
#                  Canvas | Graphics | v2022.11.13
# This function makes sure that the canvas string is
# not too short. If parts of the image are missing,
# they are filled with black pixels.
#
# Usage: FixCanvas(CANVASREF, [Width, [Height, [Depth]]])
#
sub FixCanvas
{
  my $REF = GetCanvasRef($_[0]) or return 0;
  my $W = defined $_[1] ? $_[1] : WidthOf($REF);
  my $H = defined $_[2] ? $_[2] : HeightOf($REF);
  my $D = defined $_[3] ? GetBPP($_[3]) : DepthOf($REF);
  substr($$REF, 0, 16) = 'CANVAS' .
    sprintf('%0.2d', $D << 3) . pack('NN', $W, $H);
  my $MINSIZE = $W * $H * $D + 16;
  if (length($$REF) < $MINSIZE)
    { vec($$REF, $MINSIZE - 1, 8) = 0; }
  return 1;
}
##################################################
#                            Graphics | v2022.11.8
# Returns the pixel width of the canvas.
# No error checking is done, so make sure to provide
# the correct argument everytime.
# Usage: ImageWidth = WidthOf(CANVASREF)
#
sub WidthOf
{
  my $REF = $_[0];
  return vec($$REF, 2, 32);
}
##################################################
#                            Graphics | v2022.11.8
# Returns the pixel height of the canvas.
# No error checking is done, so make sure to provide
# the correct argument everytime.
# Usage: ImageHeight = HeightOf(CANVASREF)
#
sub HeightOf
{
  my $REF = $_[0];
  return vec($$REF, 3, 32);
}
##################################################
#                  Canvas | Graphics | v2022.11.13
# Returns the image depth (bytes per pixel) of a canvas.
# No error checking is done, so make sure to provide
# the correct argument everytime!
# Usage: BytesPerPixel = DepthOf(CANVASREF)
#
sub DepthOf
{
  my $REF = $_[0];
  defined $$REF && length($$REF) > 7 or return 0;
  my $D = substr($$REF, 6, 2);
  if ($D eq '32') { return 4; }
  if ($D eq '08') { return 1; }
  return 3;
}
##################################################
#                               Math | v2022.10.11
# This function forces the INPUT_NUMBER to become
# and integer between MIN and MAX values.
# If INPUT_NUMBER is smaller than MIN, then return MIN.
# If INPUT_NUMBER is greater than MAX, then return MAX.
#
# Usage: INTEGER = IntRange(INPUT_NUMBER, MIN, MAX)
#
sub IntRange
{
  no warnings;
  my $MIN = defined $_[1] ? int($_[1]) : 0;
  my $MAX = defined $_[2] ? int($_[2]) : 4294967295;
  my $NUM = defined $_[0] ? int($_[0]) : $MIN;
  use warnings;
  $NUM > $MIN or return $MIN;
  $NUM < $MAX or return $MAX;
  return int($NUM);
}
##################################################
#                               Math | v2022.10.12
# This function converts a number to a 32-bit integer.
#
# Usage: INTEGER = Int32bit(NUMBER)
#
sub Int32bit
{
  no warnings;
  my $INT = defined $_[0] ? $_[0] & 0xffffffff : 0;
  use warnings;
  return $INT;
}
##################################################
#                                Math | v2022.11.5
# This function checks if a value is above and
# beyond a certain limit, and if it is, then it
# overwrites the first argument's value with the
# third argument's value. Returns the final new value.
#
# Also, if the first argument is undefined,
# it overwrites it with zero!
#
# Usage: NUMBER = FixOverflow(VARIABLE, LIMIT, NEWVALUE)
#
sub FixOverflow
{
  defined $_[0] or return $_[0] = 0;
  no warnings;
  my $NEW = defined $_[2] ? $_[2] : 0;
  if (defined $_[1] && $_[0] > $_[1]) { $_[0] = $NEW; }
  use warnings;
  return $_[0];
}
##################################################
#                                Math | v2022.11.5
# This function expects a list of numbers and decides
# which one is closest to the first one and returns that number.
# Returns the number itself if the list is empty.
#
# Example: NearestNum(25, 55, 35, 99) => 35
#          NearestNum(88, 90, 88, 77, 14) => 88
#          NearestNum(103) => 103
#
# Usage: NUMBER = NearestNum(FIRST_NUMBER, LIST OF NUMBERS...)
#
sub NearestNum
{
  my $FIRST = shift;
  my $NEAREST = $FIRST;
  my $LEASTDIFF = 999999999999999;
  foreach (@_)
  {
    my $DIFF = abs($FIRST - $_);
    $DIFF or return $FIRST;
    if ($LEASTDIFF > $DIFF)
    {
      $LEASTDIFF = $DIFF;
      $NEAREST = $_;
    }
  }
  return $NEAREST;
}
##################################################
#                            Graphics | v2022.11.5
# This function calculates the maximum possible
# colors based on the bit per pixel value.
#
# Usage: INTEGER = GetMaxColors(BPP)
#
sub GetMaxColors
{
  my $BPP = defined $_[0] ? $_[0] : 0;
  $BPP > 0 or return 0;
  $BPP > 24 or return 1 << 8;
  return 16777216;
}
##################################################
#                                Math | v2022.8.28
# This function raises X to the Nth power.
# Usage: INTEGER = POWER(X, N)
#
sub POWER
{
  my $X = defined $_[0] ? $_[0] : 0;
  my $N = defined $_[1] ? $_[1] : 0;
  $N > 0 or return 1;
  my $PWR = 1;
  while ($N-- > 0) { $PWR *= $X; }
  return $PWR;
}
##################################################
#                               Math | v2022.10.23
# This function forces a number to become a 32-bit
# integer and returns the negated value of that integer.
#
# Usage: INTEGER = NEG32(NUMBER)
#
sub NEG32 { return defined $_[0] && $_[0] ? ~$_[0] + 1 & 0xffffffff : 
+0; }

##################################################
#                               String | v2018.6.5
# This function inserts commas into a number at
# every 3 digits and returns a string.
# Usage: STRING = Commify(INTEGER)
# Copied from www.PerlMonks.org/?node_id=157725
#
sub Commify
{
  my $N = reverse $_[0];
  $N =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
  return scalar reverse $N;
}
##################################################
#                               File | v2022.11.17
# Reads an entire binary file or part of a file.
# This function uses sysopen(), sysseek(), and
# sysread() functions. Unlike many other perl subs,
# this function returns 0 on success or an error code:
# 1=File Not Found, 2=Not Plain File, 3=Cannot Open For Reading
# If an error occurs then the buffer will hold an empty string.
#
# The first argument is the file name.
# The second argument is a string buffer. (The buffer doesn't
# have to be initialized. It may contain an undefined value.)
# An optional 3rd argument (integer) will move
# the file pointer before reading, and an optional
# 4th argument (integer) can limit the number of
# bytes to read. These numbers cannot be negative.
# If the number of bytes to read is set to zero,
# then it will read the entire file. (default)
#
# Usage: STATUS = ReadFile(FILENAME, BUFFER, [START, [LENGTH]])
#
sub ReadFile
{
  my $F = defined $_[0] ? $_[0] : ''; # Get file name.
  $F =~ tr/\x00-\x1F\"\|*%$?<>//d;    # Remove illegal characters.
  my $FP = defined $_[2] ? $_[2] : 0; # File Pointer
  my $N = defined $_[3] ? $_[3] : 0;  # Number of bytes to read

  $_[1] = '';  # Initialize read buffer.

  -e $F or return 1;     # File exists?
  -f $F or return 2;     # Is it a plain file?
  my $SIZE = -s $F;      # Get file size.

  # Make sure all parameters are valid.
  if ($N < 0 || $FP < 0 || $FP >= $SIZE) { return 0; }
  $SIZE -= $FP;
  if ($N == 0 || $N > $SIZE) { $N = $SIZE; }

  local *FILE;
  sysopen(FILE, $F, 0) or return 3;  # Open file for read only.
  $FP && sysseek(FILE, $FP, 0);      # Move file pointer
  sysread(FILE, $_[1], $N);          # Read N bytes
  close FILE;
  return 0;
}
##################################################
#                                File | v2022.11.8
# Creates and overwrites a file in binary mode.
# If the file has already existed, it erases the
# old content and replaces it with the new content.
# Returns 1 on success or 0 if something went wrong.
#
# Usage: STATUS = CreateFile(FILENAME, CONTENT)
#
sub CreateFile
{
  my $F = defined $_[0] ? $_[0] : '';
  $F =~ tr/\x00-\x1F\"\|*%$?<>//d;    # Remove illegal characters.
  my $L  = defined $_[1] ? length($_[1]) : 0;
  local *FILE;
  open(FILE, ">$F") or return 0;
  binmode FILE;
  $L and print FILE $_[1];
  close FILE;
  -e $F or return 0;   # File exists?
  -f $F or return 0;   # It's a plain file?
  $L -= -s($F);        # Check file size.
  return !$L;
}
##################################################
[download]

[reply]
[d/l]

Re^3: Convert BMP to HTML

by pryrt (Abbot) on Oct 31, 2022 at 14:10 UTC

cavac

Re^3: Shameless plug and QR japh

second code block

GD::Image

cavac

<canvas>

Perl Monks Approved HTML tags

<canvas>

[reply]
[d/l]
[select]

Re^4: Convert BMP to HTML

by harangzsolt33 (Chaplain) on Oct 31, 2022 at 14:38 UTC

Re^5: Convert BMP to HTML

by LanX (Saint) on Nov 01, 2022 at 06:41 UTC

Some notes below your chosen depth have not been shown here

Re^5: Convert BMP to HTML

by Bod (Parson) on Oct 31, 2022 at 22:14 UTC

Some notes below your chosen depth have not been shown here

Re: Convert BMP to HTML
by Athanasius (Archbishop) on Nov 01, 2022 at 17:17 UTC

Hi harangzsolt33,

Thanks for this! As others have said, it’s cool. Here’s some feedback on the Perl code itself. I hope you find it constructive and useful.

# Tested with TinyPerl 5.8 on Windows XP and Perl 5.004 on DOS.
[download]

These are now very old. I see from your home page that Perl is a hobby for you, so you’re not constrained by workplace policies to use any particular version. I strongly recommend you upgrade to an up-to-date Perl; this will allow you to take advantage of newer syntax features. For example, instead of local *FILE you can use lexical filehandles (as of v5.6). And a statement like my $F = defined $_[0] ? $_[0] : ''; can be simplified to my $F = $_[0] // ''; using the defined-or operator // (as of v5.10).

my $REF = ReadBMP('D:\\DESKTOP\\mandel3.bmp', 3);
ReduceColorDistribution($REF);
my $HTML = Canvas2HTML($REF);
CreateFile('D:\\DESKTOP\\TESTING.HTM', $HTML);
exit;
[download]

Putting driver code at file scope can potentially lead to hard-to-find bugs. Consider:

use strict;

my $foo = 42;
print "$foo\n";     # 42. No surprises here
bar();
print "$foo\n";     # 17! How did that happen?

# ...hundreds of lines of code...

sub bar
{
    ...
    $foo = 17;      # Oops! Forgot "my"
    ...
}
[download]

As you can see, use strict only gets you so far. Since $foo is declared at file scope, it remains visible/accessible to all subroutines in the rest of the file. This action-at-a-distance is what use strict is designed to prevent; so, let strict do its job by enclosing top-level code in its own block:

MAIN:       # Label (not needed, just for documentation)
{
    my $REF = ReadBMP('D:\\DESKTOP\\mandel3.bmp', 3);
    ReduceColorDistribution($REF);
    my $HTML = Canvas2HTML($REF);
    CreateFile('D:\\DESKTOP\\TESTING.HTM', $HTML);
    exit;   # Not really needed either
}
[download]

Now $REF and $HTML are invisible/inaccessible to the rest of the file.

if ($ERR > 5) { undef $HEADER; return 0; }
[download]

The error handling looks a bit strange, but what caught my eye was the undef $HEADER; statement. This looks like a hangover from C programming, where a malloc must eventually be followed by a free to prevent a memory leak. But Perl is garbage collected; here, $HEADER is a lexical variable so it will be marked as eligible for collection as soon as it goes out of scope (viz., when the return is executed). The undef does no harm, but it also accomplishes nothing here.

And lastly,

sub ReadBMP
{
    ...
}
[download]

The body of this subroutine is 377 lines long! Well, we’ve all written the sub that wouldn’t end from time to time, but when this happens you really need to go back and refactor it into separate subroutines. An excellent rule of thumb is that each subroutine should be fully visible on the screen without scrolling. Otherwise, you’re creating problems for your future self. For example, this loop:

while ($H--)
{
[download]

caught my eye. Is the logic correct? (Because the operator is in postfix position, the condition is tested before the decrement is applied). On reflection, I think this is correct. But in order to check it, I wanted to see where $H was declared; and I had to go back 183 lines to find it! A maintenance nightmare.

Just my 2�. Hope it helps,

Athanasius <°(((>< contra mundum סתם עוד האקר של פרל,

[reply]
[d/l]
[select]

Re^2: Convert BMP to HTML

by harangzsolt33 (Chaplain) on Nov 02, 2022 at 20:37 UTC

Thank you for the suggestions! The super long sub is actually an experiment. I wrote a short one, and I noticed that there are a lot of variables, and passing them around to sub routines is no fun. For example, the part that decodes custom format BMPs would require at least 14 arguments. So, I've tried to break up this sub into 5-6 smaller sub-routines, and the result is not nice. The code didn't look pretty. So, I don't know what to do... "An excellent rule of thumb is that each subroutine should be fully visible on the screen without scrolling." Yeah, I know... It's wonderful when you have a small easy task to do, and you can do it in 35 lines of code and then return with the result. I like those kind of subs too. Then you have these monster subs that look like never-ending code and even when you try to divide the code into sections, it looks like a plate of spaghetti. Variables are created in one sub, then they are used in other subs all over. It can be a nightmare.

The only reason I like to keep my scripts compatible with Perl 5.004 is because that way they work on the earliest Perl interpreter I have in my possession. If a Perl script is backward compatible, it will still run on newer versions of Perl! It just means that it will also run on older versions too. And having a script that can run on anything is great. It's one less thing to worry about.

I didn't realize that putting the main program in brackets keeps the scope of variables out of the rest of the program. Actually, I remember reading about it. But I forgot that I can do that.

"undef $HEADER;" I have played around a lot with string variables and I noticed that if I have a very large string in a sub, exiting the sub will not destroy the big string in memory! That's unusual, but we have talked about this before in this thread: Memory usage double expected and doing undef $VARIABLE causes Perl to free up that memory.

But let me say a word about BMP image format as well. Whoever invented this stuff was really not thinking about how hard it's going to be for programmers who just want to decode a simple image. BMP images are usually stored upside down in the file BUT NOT ALWAYS. When the highest bit of the ImageHeight is 1, that means the BMP image is actually stored right side up. But it also means that you have to negate the ImageHeight before you can use it. BMP images also contain padding. And lots of it. It's all over the place. The header itself has a few bytes of empty space. The palette usually has a bunch of empty space in it (about 256 bytes or so). And each line of the image has padding at the end. The padding depends on how wide the image. In RLE compressed BMP files, the end of each line has an extra null byte SOMETIMES but not always. The BMP file header contains several different variables to describe the image format. One is used for compression. Okay, this value is stored in a 32-bit unsigned int, but it only has 4 VALID VALUES: 0, 1, 2, 3. Zero means no compression is used at all. One and two means RLE compression is used. And 3 indicates that it's a custom-format BMP file (which means that the red, green and blue values do not appear where they normally do in standard uncompressed BMP file. Normally, you have BLUE, then GREEN, then RED in this order. But in a custom-format BMP file, the RGB values can be in any order, and they can take up 1-8 bits or even more. There is total flexibility here.) So, the compression is stored in 32 bits but only the first two bits are used. We store the BITS_PER_PIXEL (BPP) in 16 bits but only the first 6 bits are ever used. Then there are the COLORS value which is 32 bits but never uses more than 8 bits. The FILESIZE and DATASIZE, on the other hand, uses ONLY 32 bits to store the obvious, and they are completely unnecessary. In fact, most programs ignore these values, because they CAN BE ZERO sometimes. The BMP header has a variable size. And it also has version number. There are specific versions, and each one is slightly different. There's version 12, 16, 40, 54, 56, 108 and 124. After version 40, which is considered the "standard," there was little change. But the fact that you have so many unused space in a file and so many rules makes it only harder to decode the image. The designers of BMP weren't thinking about SIMPLICITY. Even a 5-year-old could design a better file format. Consider the SUN Raster image file format, for example. It has a 32-byte header which is ALWAYS 32 bytes long and always holds exactly eight 32-bit unsigned integers in big-endian format. They contain the image width and height, the palette size, datasize, compression and a few other things. VERY SIMPLE. You don't need a 300-line sub to decode it. Even the RLE compression algorithm they use is A LOT nicer and more efficient than what BMP uses. RAS files do not use padding and don't waste space, and usually a simple uncompressed image is going to be somewhat smaller than a BMP file. Not only it's smaller, but the decoder program is a lot simpler too. I really wish RAS images were more popular than BMP, but today RAS is hardly even known. It's literally a non-existent format nowadays.

[reply]

Re^3: Convert BMP to HTML

by Athanasius (Archbishop) on Nov 03, 2022 at 12:12 UTC

Hi harangzsolt33,

The only reason I like to keep my scripts compatible with Perl 5.004 is because that way they work on the earliest Perl interpreter I have in my possession. ... And having a script that can run on anything is great. It's one less thing to worry about.

Okay, but that just begs the question: why do you want to support legacy versions of the perl interpreter? Upgrading to shiny new¹ versions gives you at least three benefits:

Improved Perl syntax, as mentioned previously.
Enhanced performance.
Access to a much wider range of CPAN modules.

With a few minor exceptions,² your old scripts should still run fine on the more modern perl interpreters.

I have played around a lot with string variables and I noticed that if I have a very large string in a sub, exiting the sub will not destroy the big string in memory! ... and doing undef $VARIABLE causes Perl to free up that memory.

Are you sure you were using lexical variables when you observed this?

The super long sub is actually an experiment. I wrote a short one, and I noticed that there are a lot of variables, and passing them around to sub routines is no fun. ... So, I've tried to break up this sub into 5-6 smaller sub-routines, and the result is not nice. The code didn't look pretty. So, I don't know what to do...

That’s a pretty good indication that an object oriented approach is called for.

¹Well, new-ish. The latest poll made me realise that my version of Strawberry Perl (the newest they offer) is now two years out of date. :-(
²For example, on newer versions (5.26 and later) the current directory . is no longer included in @INC by default. This is actually a Good Thing.

Cheers,

Athanasius <°(((>< contra mundum סתם עוד האקר של פרל,

[reply]
[d/l]
[select]

Re^4: Convert BMP to HTML

by marto (Cardinal) on Nov 03, 2022 at 12:20 UTC

Re: Convert BMP to HTML
by LanX (Saint) on Oct 30, 2022 at 13:38 UTC

> Please don't punish me.

no way, hacking the monastery is quite common here.

see also "free nodelet hacks" like Free Nodelet Hack: 'Newest Nodes' Menubar or my own Wikisyntax for the Monastery

But unfortunately translating every pixel to ~20 bytes is also a waste of bandwidth, so a JS solution� could be handy...

update

�) I think that's the way to go

SO: convert-and-insert-base64-data-to-canvas-in-javascript

Cheers Rolf
_{(addicted to the 𐍀𐌴𐍂𐌻 Programming Language :)

Wikisyntax for the Monastery}

[reply]

Re^2: Convert BMP to HTML

by harangzsolt33 (Chaplain) on Oct 31, 2022 at 04:48 UTC

By the way, I don't convert every pixel into 20 bytes. Some pixels become a single "<TD>" tag, which is only 4 bytes. If the picture has a background that is solid white, that's the best. Like for example, here is a photo of me. I just cut out the background with a photo editor, so it's pure white. The script realizes that white is the most common color used in this pic, so it sets the background color to white. Then it just compresses a single white line like so: "<TD COLSPAN=70>" because it's a 70 x 94 pic. It becomes exactly 64,418 bytes, which is 9.78 bytes per pixel. Ouch! Yeah, that's not good, but it's not 20 bytes per pixel. Actually, it could be better with some more optimization.

[reply]

Re^2: Convert BMP to HTML

by harangzsolt33 (Chaplain) on Oct 31, 2022 at 02:27 UTC

[reply]

Re: Convert BMP to HTML
by roboticus (Chancellor) on Oct 31, 2022 at 16:41 UTC

harangzsolt33:

Far out! I'll definitely have to play around with it.

...roboticus

When your only tool is a hammer, all problems look like your thumb.

[reply]

Re: Convert BMP to HTML
by harangzsolt33 (Chaplain) on Oct 30, 2022 at 05:50 UTC

[reply]


Think about Loose Coupling
	PerlMonks