#!/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 the 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 closed 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 expand 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 = $ImageWidth - $x - 1; } if ($y < 0) { $y = 0; } elsif ($y + $h >= $ImageHeight) { $h = $ImageHeight - $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-32767 $H >= 0 or $H = 0; $H < 32768 or $H = 32767; # Allowed Height: 0-32767 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 into $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, $Width, $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, returns zero. # EXIT(EXITCODE, ERROR_MESSAGE) # Displays error message, returns 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 = ; } 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"; } ##################################################