I wrote this over the past couple of days. This could be a good starting point for you. This program stores raw image data in a string, because arrays take up a lot more space in memory than simple strings. (When you work with a large image, it makes a big difference whether you need 1 gigabyte or 30 gigabytes of memory to store the image. So, a string is a better solution.) This code could be streamlined in a lot of ways to make it faster, but it's okay for a start. The program saves the image in the current directory as a BMP file. It will be called test.bmp. It draws a few things on the image and saves it and also dumps its contents to stdout...
#!/usr/bin/perl -w
use strict;
use warnings;
#
# These are some useful functions for working with BMP (Bitmap) files.
#
my $PAUSE = 0; # Require user to press enter before script ends.
my $CURDIR = GetCurrentDirectory();
my $OUTPUT_FILE = $CURDIR . 'test.bmp';
my $IMAGE = CreateCanvas(100, 100); # Creates a 100x100 image with
+white background.
for (my $y = 0; $y < 100; $y++)
{
for (my $x = 0; $x < 100; $x++)
{
my $Color = RGB($x * 2, 0, $y * 2);
SetPixel($x, $y, $IMAGE, $Color);
}
}
SetPixel(3, 3, $IMAGE, 0xFFFF00);
DrawRandomDots($IMAGE, 500); # Draw 500 random dots all over t
+he image.
FlipVertical($IMAGE);
DrawBox(10, 10, 30, 20, $IMAGE, 0xFFC000);
DrawBox(15, 15, 30, 20, $IMAGE, 0xFFEE66);
DrawBox(20, 20, 30, 20, $IMAGE, 0xFFFFFF);
SaveBMP($OUTPUT_FILE, $IMAGE);
OpenPhotoEditor($OUTPUT_FILE);
HexDump($IMAGE);
print "\nMemory reserved for this image: ", Commify(length($IMAGE)), "
+ bytes\n";
print "\nImage saved as BMP to $OUTPUT_FILE\n";
EXIT(0);
##################################################
# MORE STUFF TO DO:
sub ReadBMP {}
sub ExpandImage {}
sub CopyBox {}
sub MoveBox {}
sub FlipHorizontal {}
sub Flip90Degrees {}
sub CropImage {}
sub InsertImage {}
sub MergeImage {}
sub DrawLine {}
sub DrawSquare {}
sub DrawCircle {}
sub DrawEllipse {}
sub SprayPaint {}
sub FillArea {}
sub PutText {}
sub AdjustBrightness {}
sub AdjustContrast {}
sub AdjustSaturation {}
sub AdjustHue {}
sub SharpenImage {}
sub SmoothImage {}
sub MosaicImage {}
sub InvertColors {}
sub Convert2GreyScale {}
##################################################
# v2021.12.31
# This function opens Windows Paint to view or
# edit the photo. On Linux, this function doesn't
# do anything (yet).
# Usage: OpenPhotoEditor(FileName)
#
sub OpenPhotoEditor
{
my $FileName = defined $_[0] ? $_[0] : '';
my $OS = uc($^O);
index($OS, 'MSWIN') >= 0 or return;
# Open Windows Paint and continue with perl script...
# Remove the word "START" to cause perl to wait until Paint is close
+d before continuing.
system("START C:\\WINDOWS\\SYSTEM32\\MSPAINT.EXE \"$FileName\"");
}
##################################################
sub CEIL { int($_[0]) + ($_[0] - int($_[0]) > 0) }
##################################################
# v2021.12.31
# Returns a 24-bit integer after fusing together
# the RED, GREEN and BLUE values.
# Usage: INTEGER = RGB(RED, GREEN, BLUE)
#
sub RGB { return (($_[0] & 255) << 16) | (($_[1] & 255) << 8) | ($_[2]
+ & 255); }
##################################################
# v2021.12.31
# Fuses RED, GREEN and BLUE values into a 3-byte string.
# Usage: STRING = RGB2str(INTEGER, INTEGER, INTEGER)
#
sub RGB2str
{
my $C = '';
vec($C, 0, 8) = $_[0] & 255;
vec($C, 1, 8) = $_[1] & 255;
vec($C, 2, 8) = $_[2] & 255;
return $C;
}
##################################################
# v2021.12.31
# Converts a 24-bit integer to a 3-byte string.
# Usage: STRING = Color2str(INTEGER)
#
sub Color2str
{
my $C = '';
vec($C, 0, 8) = ($_[0] >> 16) & 255; # Write RED
vec($C, 1, 8) = ($_[0] >> 8) & 255; # Write GRN
vec($C, 2, 8) = $_[0] & 255; # Write BLU
return $C;
}
##################################################
# v2021.12.31
# Returns a random RGB color as a 24-bit integer.
# Usage: INTEGER = RandomColor()
#
sub RandomColor
{
my $R = (rand() * 7285799078) & 255;
my $G = (rand() * 6231646627) & 255;
my $B = (rand() * 5465284336) & 255;
return RGB($R, $G, $B);
}
##################################################
# v2021.12.31
# Draws a bunch of random boxes on the image.
# Usage: DrawRandomBoxes(ImageData, Count)
#
sub DrawRandomBoxes
{
my $COUNT = defined $_[1] ? $_[1] : 0;
my $ImageWidth = vec($_[0], 0, 16);
my $ImageHeight = vec($_[0], 1, 16);
while ($COUNT--)
{
my $x = int(rand($ImageWidth)) >> 1;
my $y = int(rand($ImageHeight)) >> 1;
my $w = int(rand() * $ImageWidth) >> 1;
my $h = int(rand() * $ImageHeight) >> 1;
DrawBox($x, $y, $w, $h, $_[0], RandomColor());
}
}
##################################################
# v2021.12.31
# Draws a filled box on an image.
# Usage: DrawBox(x, y, Width, Height, Image, Color)
#
sub DrawBox
{
my ($x, $y, $w, $h, $Data, $Color) = @_;
# Make sure we have the right arguments
# If any coordinates are outside the image boundaries, we don't expa
+nd the image.
return if ($w <= 0 || $h <= 0);
my $ImageWidth = vec($Data, 0, 16);
my $ImageHeight = vec($Data, 1, 16);
return if ($x >= $ImageWidth);
return if ($y >= $ImageHeight);
if ($x < 0) { $x = 0; } elsif ($x + $w >= $ImageWidth) { $w = $Image
+Width - $x - 1; }
if ($y < 0) { $y = 0; } elsif ($y + $h >= $ImageHeight) { $h = $Imag
+eHeight - $y - 1; }
$Color = Color2str($Color);
my $x2 = $x + $w;
my $y2 = $y + $h;
for (; $y <= $y2; $y++)
{
my $PTR = ($y * $ImageWidth + $x) * 3 + 4;
for (my $i = 0; $i <= $w; $i++)
{
substr($_[4], $PTR, 3, $Color);
$PTR += 3;
}
}
}
##################################################
# v2021.12.30
# Draws random dots all over the image.
# Usage: DrawRandomDots(ImageData, Count)
#
sub DrawRandomDots
{
my $ImageWidth = vec($_[0], 0, 16);
my $ImageHeight = vec($_[0], 1, 16);
my $COUNT = defined $_[1] ? $_[1] : 10;
while ($COUNT--)
{
my $X = int(rand($ImageWidth));
my $Y = int(rand($ImageHeight));
SetPixel($X, $Y, $_[0], RandomColor());
}
}
##################################################
# v2021.12.29
# Changes the color of one pixel in an image.
#
# NO ERROR CHECKING IS DONE!
# Do not call this function with coordinates that
# are outside the boundaries of the image! Doing so
# will have undesired results! If any arguments are
# missing, this function will still do something
# you probably don't want...
#
# The color must be an integer whose lower 24 bits
# store the values for red, green and blue.
# Example: 0xFFCC00 = orange
#
# Usage: SetPixel(x, y, Image, Color)
#
sub SetPixel
{
my $Width = vec($_[2], 0, 16);
my $PTR = (($_[1] * $Width) + $_[0]) * 3 + 4;
my $RGB = $_[3];
substr($_[2], $PTR, 3, Color2str($RGB));
}
##################################################
# v2021.12.29
# This function creates a canvas in memory and fills
# it with the given color. The color must be an
# integer whose lower 24 bits store the color values
# for red, green and blue. Example: 0xFFFF00 = yellow
# Minimum size of the canvas: 0 x 0 pixels
# Maximum size of the canvas: 32767 x 32767 pixels
# If no arguments are provided, this function returns
# a 1x1 image that contains one white pixel.
#
# The "canvas" or "image" returned by this function
# is a simple string that contains raw bitmap data
# (which is not the same as the BMP file format).
#
# Example: CreateCanvas(120, 100, 0xFF0000)
# Creates a 120x100 image that is solid red color.
#
# Usage: STRING = CreateCanvas(Width, Height, [Color])
#
sub CreateCanvas
{
my $W = defined $_[0] ? int($_[0]) : 1;
my $H = defined $_[1] ? int($_[1]) : 1;
my $C = defined $_[2] ? int($_[2]) : 0xFFFFFF;
$W >= 0 or $W = 0; $W < 32768 or $W = 32767; # Allowed Width: 0-32
+767
$H >= 0 or $H = 0; $H < 32768 or $H = 32767; # Allowed Height: 0-3
+2767
my $SIZE = '';
vec($SIZE, 0, 16) = $W; # Store image width
vec($SIZE, 1, 16) = $H; # Store image height
my $PIXEL = Color2str($C); # Write color value i
+nto $PIXEL as string
return $SIZE . ($PIXEL x ($W * $H));
}
##################################################
# v2021.12.30
# This function flips an image vertically.
# Usage: FlipVertical(ImageData)
#
sub FlipVertical
{
defined $_[0] or return;
my $ImageWidth = vec($_[0], 0, 16);
my $ImageHeight = vec($_[0], 1, 16);
$ImageWidth > 0 or return;
$ImageHeight > 1 or return;
my $t;
my $FirstLine = 0;
my $LastLine = $ImageHeight - 1;
my $Lines = int($ImageHeight >> 1);
while ($Lines--)
{
my $P1 = $FirstLine * $ImageWidth * 3 + 4;
my $P2 = $LastLine * $ImageWidth * 3 + 4;
for (my $i = 0; $i < $ImageWidth * 3; $i++)
{
$t = vec($_[0], $P2, 8);
vec($_[0], $P2, 8) = vec($_[0], $P1, 8);
vec($_[0], $P1, 8) = $t;
$P2++;
$P1++;
}
$FirstLine++;
$LastLine--;
}
}
##################################################
# v2021.12.29
# Converts ImageData to a Bitmap (BMP) image format
# and outputs it either to a file or to stdout.
# ImageData should be a string starting with
# 16-bit width and 16-bit height of the image,
# followed by 24-bit RRGGBB value groups.
# Returns 1 on success or 0 if something went wrong.
#
# Usage: INTEGER = SaveBMP(FileName, ImageData)
#
sub SaveBMP
{
@_ == 2 or return 0;
my $FileName = defined $_[0] ? $_[0] : '';
my $Data = defined $_[1] ? $_[1] : '';
my $Width = vec($Data, 0, 16);
my $Height = vec($Data, 1, 16);
my $HEADERLEN = 54;
my $BITS_PER_PIXEL = 24;
my $PADDING = $Width & 3;
my $DATASIZE = ($Width * 3 + $PADDING) * $Height;
my $FILESIZE = $DATASIZE + $HEADERLEN;
my $OUTPUT = 'BM' . pack('VxxxxVVVV', $FILESIZE, $HEADERLEN, 40, $Wi
+dth, $Height) . chr(1) . pack('xCxxxxxV', $BITS_PER_PIXEL, $DATASIZE)
+ . "\0" x 16;
# BMP files contain images upside down,
# so we flip the data as we copy it into $OUTPUT.
my $BYTES_PER_LINE = $Width * 3;
my $src = ($Height - 1) * $BYTES_PER_LINE + 4;
while ($src > 0)
{
# Not so fast... BMP files also contain R-G-B values as B-G-R, so
+here
# we swap the Red and Blue values one by one before we write them
+into $OUTPUT.
my $LINE = substr($Data, $src, $BYTES_PER_LINE);
for (my $i = 0; $i < $BYTES_PER_LINE; $i += 3)
{
my $t = vec($LINE, $i+2, 8);
vec($LINE, $i+2, 8) = vec($LINE, $i, 8);
vec($LINE, $i, 8) = $t;
}
$OUTPUT .= $LINE;
$src -= $BYTES_PER_LINE;
$PADDING or next;
$OUTPUT .= "\0" x $PADDING;
}
if (length($FileName)) { return CreateFile($FileName, $OUTPUT); }
+ # Save BMP to file
# Print to stdout instead...
$| = 1;
print "Content-Type: image/bmp\nContent-Length: ", length($OUTPUT),
+"\n\n", $OUTPUT;
return 1;
}
##################################################
# v2019.6.15
# Sends a simple B/W bitmap image to stdout.
# Usage: SpitBMP([[WIDTH], HEIGHT])
#
sub SpitBMP
{
$| = 1;
my $W = defined $_[0] ? $_[0] : 1;
my $H = defined $_[1] ? $_[1] : 1;
my $HEADERLEN = 62;
my $BITS_PER_PIXEL = 1;
my $DATASIZE = CEIL(($W * $H) >> 3);
my $FILESIZE = $DATASIZE + $HEADERLEN;
my $HEADER = 'BM' . pack('VxxxxVVVV', $FILESIZE, $HEADERLEN, 40, $W,
+ $H) . chr(1) . pack('xCxxxxxV', $BITS_PER_PIXEL, $DATASIZE) . "\0" x
+ 20 . "\xFF\xFF\xFF\0";
my $OUTPUT = $HEADER . "\0" x $DATASIZE;
print "Content-Type: image/bmp\n",
'Content-Length: ', length($OUTPUT), "\n\n", $OUTPUT;
}
##################################################
#
# This function produces a 16-color 1x1 BMP image
# and sends it to stdout.
# Usage: SpitColorBMP(COLOR)
#
# Example: SpitColorBMP('A0') ---> red pixel
# SpitColorBMP('90') ---> green pixel
#
sub SpitColorBMP
{
$| = 1;
my $Y = "\0"x2;
my $Z = "\0"x3;
my $COLOR = defined $_[0] ? $_[0] : 0;
print "Content-type: image/bmp\n\n",
"BMz", chr(0)x7, "v$Z($Z\x01$Z\x01$Z",
"\x01\0\x04$Z$Y\x04", chr(0)x25, "\x80$Y\x80$Z",
"\x80\x80\0\x80$Z\x80\0\x80\0\x80\x80$Y\x80\x80",
"\x80\0\xC0\xC0\xC0$Z\xFF$Y\xFF$Z\xFF\xFF\0\xFF",
"$Z\xFF\0\xFF\0\xFF\xFF$Y\xFF\xFF\xFF\0", chr(hex($COLOR)), "$Z";
}
##################################################
# v2019.11.24
# Creates and overwrites a file in binary mode.
# Returns 1 on success or 0 if something went wrong.
# Usage: INTEGER = CreateFile(FILE_NAME, CONTENT)
#
sub CreateFile
{
defined $_[0] or return 0;
my $F = $_[0];
$F =~ tr/\"\0*?|<>//d; # Remove special characters
length($F) or return 0;
local *FH;
open(FH, ">$F") or return 0;
binmode FH;
if (defined $_[1] ? length($_[1]) : 0) { print FH $_[1]; }
close FH or return 0;
return 1;
}
##################################################
#
# This function prints the contents of a file in
# hex format and plain text along with the address.
# Usage: HexDump(STRING)
#
sub HexDump
{
my $c;
my $j = 0;
my $S = shift;
my $WIDTH = 80;
my $LINE_WIDTH = ($WIDTH > 150) ? 32 : 16;
my $BYTES = 0;
print "\n";
for (my $i = 0; $i < length($S); )
{
$BYTES += $LINE_WIDTH;
printf('%.10X ', $i);
for (my $k = 0; $k < $LINE_WIDTH; $k++)
{
$c = vec($S, $i + $k, 8);
if ($i + $k < length($S))
{
print ($k == 8 ? '-' : ' ');
printf('%.2X', $c);
}
else
{ print ' '; }
}
print ' ';
for (my $k = 0; $k < $LINE_WIDTH; $k++)
{
$c = vec($S, $i + $k, 8);
if ($i + $k < length($S))
{
if ($c < 32 || $c > 126) { $c = 46; }
printf('%c', $c);
}
else
{
print ' ';
}
}
print "\n";
if ($BYTES == 512) { print "\n"; $BYTES = 0; }
$i += $LINE_WIDTH;
}
}
##################################################
# v2021.1.20
# Returns the current working directory.
# Usage: STRING = GetCurrentDirectory()
#
sub GetCurrentDirectory
{
my $PATH = Trim(exists($ENV{PWD}) ? $ENV{PWD} : `cd`);
my $Slash = vec($PATH, length($PATH) - 1, 8);
if ($Slash == 47 || $Slash == 92) { return $PATH; }
my $OS = uc($^O);
$Slash = index($OS, 'LINUX') >= 0 ? '/' : '\\';
return $PATH . $Slash;
}
##################################################
# v2019.8.25
# Removes whitespace from before and after STRING.
# Whitespace is here defined as any byte whose
# ASCII value is less than 33. That includes
# tabs, esc, null, vertical tab, new lines, etc.
# Usage: STRING = Trim(STRING)
#
sub Trim
{
defined $_[0] or return '';
(my $L = length($_[0])) or return '';
my $P = 0;
while ($P <= $L && vec($_[0], $P++, 8) < 33) {}
for ($P--; $P <= $L && vec($_[0], $L--, 8) < 33;) {}
substr($_[0], $P, $L - $P + 2);
}
##################################################
#
# 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;
}
##################################################
# v2021.12.27
# Terminates the script and may display an error
# message and the "PRESS ENTER TO EXIT" message.
# Usage: EXIT() # Returns zero.
# EXIT(EXITCODE) # Returns EXITCODE.
# EXIT(ERROR_MESSAGE) # Displays error message, re
+turns zero.
# EXIT(EXITCODE, ERROR_MESSAGE) # Displays error message, re
+turns EXITCODE.
#
sub EXIT
{
my $STATUS = defined $_[0] ? $_[0] : 0;
if (defined $_[1])
{ print $_[1]; }
elsif (length($STATUS) > 3)
{ print $STATUS; $STATUS = 0; }
if ($PAUSE)
{
$| = 1;
CENTER('<<< PRESS ENTER TO EXIT >>>');
$PAUSE = <STDIN>;
}
exit $STATUS;
}
##################################################
# Prints some text in the center of the screen.
# Usage: CENTER(TEXT)
#
sub CENTER
{
my $WIDTH = 80;
my $TEXT = defined $_[0] ? $_[0] : '';
$TEXT = (' ' x (int(($WIDTH - length($TEXT)) / 2))) . substr($TEXT,
+0, $WIDTH);
print "\n$TEXT\n";
}
##################################################
| [reply] [d/l] |