Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

How to create and save an image from RGB values

by bliako (Monsignor)
on Dec 27, 2021 at 23:23 UTC ( #11139959=perlquestion: print w/replies, xml ) Need Help??

bliako has asked for the wisdom of the Perl Monks concerning the following question:

I can't find a (reasonably) fast method to create an image from scratch by supplying it an array of raw RGB values (or permutations of A,R,G,B). (note: the array of raw RGB can be modified to suit the scheme supported by the method). The best I could achieve was with Imager but setpixel takes ages obviously:

my $W = 100; my $H = 100; # $result is a 1D array of rgb values for $Wx$H # rgb values may actually be ARGB or RGBA etc. but I can transform # this to suit a module my $imager = Imager-> new( xsize => $W, ysize => $H, channels => 3, ) or die "called to Imager-> new() has failed."; for my $x (0..$W){ for my $y (0..$H){ my $rgb = $result->[$x + $y * $W]; next unless defined $rgb; # ARGB here, or any other scheme my $R = ($rgb & 0x00FF0000) >> 16; my $G = ($rgb & 0x0000FF00) >> 8; my $B = ($rgb & 0x000000FF); $imager->setpixel(x=>$x, y=>$y, color => [$R, $G, $B]); } } $imager-> write(file => 'out.png', type=>'png')

Edit: Ideally, I would like a method which just takes in an array of RGB values and creates the image (fastly).

Replies are listed 'Best First'.
Re: How to create and save an image from RGB values
by vr (Curate) on Dec 28, 2021 at 12:35 UTC

    I think Imager is good enough for this task. Though starting point looks strange to me, but assuming there already is, as in OP, a Perl array of (unusual) ARGB packed colour values, read the 4 channels, then just drop useless 0th channel. Otherwise the hassle with "combine" (or something similar, TMTOWTDI), etc. is unnecessary, of course.

    use strict; use warnings; use Imager; use constant IMAGESIZE => 300; use constant ROSYBROWN => 0x00BC8F8F; my @result = map { # make us some picture to find when ( ROSYBROWN ) x $_, # examining output, let it be random int( rand 0xFFFFFFFF ), # colour diagonal on uniform BG ( ROSYBROWN ) x ( IMAGESIZE - $_ - 1 ), } 0 .. IMAGESIZE - 1; my $img = Imager-> new( type => 'raw', xsize => IMAGESIZE, ysize => IMAGESIZE, data => pack( 'L>*', @result ), raw_interleave => 0, raw_datachannels => 4, raw_storechannels => 4, ); Imager-> combine( src => [ $img, $img, $img ], channels => [ 1, 2, 3 ], )-> write( file => 'test.png' );

      Thanks, that is what I was looking for, last night: pass Imager a data array or pack'ed binary data. I could not hit that in any doc (with my limited bandwidth). And even now Imager::Draw manages to confuse me more than clear it up.

      Is the following equivalent without the functionality of switching the channels (I can create data with any channel arrangement)? Note how I had to change ROSYBROWN to RGBA and that non-transparent seems to be 0xFF!

      use strict; use warnings; use Imager; use constant IMAGESIZE => 300; # RBGA use constant ROSYBROWN => 0xBC8F8FFF; my @result = map { # make us some picture to find when ( ROSYBROWN ) x $_, # examining output, let it be random int( rand 0xFFFFFFFF ), # colour diagonal on uniform BG ( ROSYBROWN ) x ( IMAGESIZE - $_ - 1 ), } 0 .. IMAGESIZE - 1; my $img = Imager-> new( type => 'raw', xsize => IMAGESIZE, ysize => IMAGESIZE, data => pack( 'L>*', @result ), raw_interleave => 0, raw_datachannels => 4, raw_storechannels => 4, ); $img->write(file=>'out.png');

        Opaque is "1", transparent is "0", that's correct. When 0th (alpha in that case) channel was discarded, its content was irrelevant. Your code is not equivalent, it produces RGBA PNG image (partial random transparency over diagonal). Simply write:

        raw_storechannels => 3,

        then Imager will discard 4th (3d, counting from 0) i.e. alpha channel on reading, and then, too, its content would be irrelevant (ROSYBROWN's 4th byte could be any). Then file created will be opaque RGB PNG.

        As an aside, I find Imager documentation excellent, but then all people are different, they say :)

Re: How to create and save an image from RGB values -- GD
by Discipulus (Abbot) on Dec 28, 2021 at 08:58 UTC
    hello bliako,

    also XPM format (used for icons in Tk) can be fed with an array like in my woodpeaker icon

    I rewrote your exmple using GD and maybe is faster (untested).

    my $W = 100; my $W = 100; use GD; # create a new image $im = new GD::Image($W,$W) or die "called to new GD::Image has failed +.";; for my $x (0..$W){ for my $y (0..$H){ my $rgb = $result->[$x + $y * $W]; next unless defined $rgb; # ARGB here, or any other scheme my $R = ($rgb & 0x00FF0000) >> 16; my $G = ($rgb & 0x0000FF00) >> 8; my $B = ($rgb & 0x000000FF); my $color = $im->colorAllocate($R, $G, $B); $im->setPixel($x, $y, $color); } } open my $outfile, '>', 'out.png' or die; binmode $outfile; print $outfile $im->png(0); # 0 is no compression. Possible values 0-9

    L*

    There are no rules, there are no thumbs..
    Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
Re: How to create and save an image from RGB values
by bliako (Monsignor) on Dec 28, 2021 at 11:42 UTC

    This works for me. I have used Image::PNG::Libpng. Somehow last night, in the dark, it looked scary but in the light of day it turns out to be quite adorable. And fast too.

    use Image::PNG::Libpng ':all'; use Image::PNG::Const ':all'; my $W = 500; my $H = 500; my $compression_level = 9; ################################# my %ihdr = ( width => $W, height => $H, bit_depth => 8, # one of: PNG_COLOR_TYPE_GRAY, PNG_COLOR_TYPE_GRAY_ALPHA, PNG_COLO +R_TYPE_PALETTE, PNG_COLOR_TYPE_RGB, PNG_COLOR_TYPE_RGB_ALPHA. color_type => PNG_COLOR_TYPE_RGB, ); my @rows; for my $y (0..$H-1){ # each row is a binary string packing $W (R,G,B) triplets (not + an array) # so we keep appending to this binary buffer (a string! but bi +nary string ok,right?) my $col_bin_str = ""; for my $x (0..$W-1){ my $R = int(rand()*0x100); my $G = int(rand()*0x100); my $B = int(rand()*0x100); # test compression with this "compressable" content # my ($R, $G, $B) = (0xFF) x 3; # pack an R,G,B tripplet into 3 bytes, each an unsingned char # that would be different for different scheme (RGBA) +etc. $col_bin_str .= pack "CCC", $R, $G, $B; } push @rows, $col_bin_str; } my $png = create_writer('file.png'); $png->set_compression_level($compression_level); $png->set_IHDR(\%ihdr); $png->set_rows(\@rows); $png->write_png();

    bw, bliako

Re: How to create and save an image from RGB values [Tk in ~0.059s]
by kcott (Archbishop) on Dec 29, 2021 at 01:22 UTC

    G'day bliako,

    "Ideally, I would like a method which just takes in an array of RGB values and creates the image (fastly)."

    The following Tk code does this.

    #!/usr/bin/env perl use strict; use warnings; use Tk; use Tk::PNG; use Time::HiRes 'time'; my $mw = MainWindow::->new(); my @common_raw_rgbs; my $png_image = 'pm_11139959_image.png'; my ($W, $H) = (100, 100); { no warnings 'qw'; @common_raw_rgbs = qw{ #ff0000 #ffff00 #009900 #00ffff #0000ff #ff00ff }; } my @raw_rgbs = (@common_raw_rgbs) x int(1 + ($W * $H / (0+@common_raw_ +rgbs))); my $t0 = time; my $image = $mw->Photo(-format => 'png', -width => $W, -height => $H); my $i = 0; for my $y (0 .. $H - 1) { for my $x (0 .. $W - 1) { $image->put([$raw_rgbs[$i++]], -to => $x, $y, $x + 1, $y + 1); } } $image->write($png_image); my $t1 = time; $mw->Label(-text => 'Image:')->pack(); $mw->Label(-image => $image)->pack(); $mw->Label(-text => 'Time: ' . sprintf '%.6f', $t1 - $t0)->pack(); MainLoop;

    Notes:

    • The GUI renders the image and shows the time taken.
      • The GUI image is exact size. I used Gimp to look at the disk copy and zoomed in to see details.
      • The time is measured from just before the unpopulated Tk::Photo is created, to just after the final PNG is written to disk — all tests gave this as a tad over 59ms; as always, YMMV.
    • I took some minor liberties with the array of RGB values — @raw_rgbs actually contains 10,002 elements; a 100x100 image only has 10,000 pixels — because I couldn't tell how you were aligning image size with array length.
      • If they're both the same size, nothing further needs doing.
      • If the array is smaller, you may want to pad the image with transparent pixels or, perhaps, use some default background colour.
      • If the array is larger you can: truncate the array; simply not use the excess elements (in my code, I didn't put() the last two elements); or, modify the image size at the outset (some decisions for you regarding how you'd want to go about this).

    — Ken

Re: How to create and save an image from RGB values
by LanX (Sage) on Dec 27, 2021 at 23:35 UTC
    For the records:

    We talked about it in the CB and I suggested to create a trivial lossless and uncompressed intermediary raster-image file in a format known to ImageMagick's convert

    But I failed to find a sufficiently easy format or a module helping writing it.

    Possible candidates are GIF , TIFF , BMP ...

    They all require to pack some non-trivial headers.

    Cheers Rolf
    (addicted to the Perl Programming Language :)
    Wikisyntax for the Monastery

    update

    ) to be further converted to a highly compressed format

      How about the PPM format? It's as simple as e.g. "P6 640 480 255\n" followed by the raw RGB binary data. It can be transformed by ImageMagick to any desired format.

      Alternatively, see the write_to_scalar example in Image::PNG::Libpng.

        > How about the PPM format?

        Yeah, that's pretty much what I was imagining (no pun intended ;)

        Cheers Rolf
        (addicted to the Perl Programming Language :)
        Wikisyntax for the Monastery

      Welcome old friend Netpbm / ppm, that's OK but something more efficient (in output file size as well as output file format) is needed. Thanks.

        You didn't say it's such an amount of data, I'm wondering what kind of images you are creating. Charts? Fractals?

        Anyway ... It's been a while since I've worked with convert , but IIRC it's possible to compose bigger pics from smaller ones.

        So you could write out PPM's of small temporary chunks (like stripes of lines) and convert them to your desired compact format and finally glue all parts together.

        update

        ) more importantly, how are you able to keep your RGB array in memory if it's too big for the disk?

        Cheers Rolf
        (addicted to the Perl Programming Language :)
        Wikisyntax for the Monastery

Re: How to create and save an image from RGB values
by Fletch (Bishop) on Dec 28, 2021 at 02:11 UTC

    No idea where to start but maybe PDL has something faster to take maybe arrays into a matrix into an image that you could save?

    The cake is a lie.
    The cake is a lie.
    The cake is a lie.

      I knew my spidey-sense was tingling! Check out PDL::IO::Pic.

      (It's a pity PerlMonks hasn't caught up to the shutdown/redirecting of search.cpan.org to metacpan.org with their mod:// links)

        > (It's a pity PerlMonks hasn't caught up to the shutdown/redirecting of search.cpan.org to metacpan.org with their mod:// links)

        ? ? ?

        Are you confusing [cpan://...] with [mod://...] ?

        Cheers Rolf
        (addicted to the Perl Programming Language :)
        Wikisyntax for the Monastery

Re: How to create and save an image from RGB values
by harangzsolt33 (Friar) on Dec 31, 2021 at 09:27 UTC
    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"; } ##################################################

      harangzsolt33++, thanks for this! that's a lot of work you have there!

      bw, bliako

        Yes, I should note as a disclaimer that I am a Perl beginner, so this code will need a lot of improvement. But it demonstrates how to create a BMP file quickly. I might write a ReadBMP() sub next year!

        (When I write or modify a sub that I have written earlier, I always put a date stamp in the description. That way I know if it is recent version or if it needs to be updated.)

Re: How to create and save an image from RGB values
by harangzsolt33 (Friar) on Dec 29, 2021 at 18:57 UTC
    So, why don't you just save your data as a 24-bit BMP image? Those are pretty simple format. It contains a pretty simple header, which is just a few bytes, followed by : Blue value (1 byte); Green value (1 byte); Red value (1 byte); at the end of a horizontal line, there are two zero bytes. Next line. Same thing. At the end of the file: two zero bytes. Pretty simple. You should write your own SaveBMP() function. I am thinking about writing one, because I may need it as well....

    sub SaveBMP       # Usage: SaveBMP($filename, $width, $height, $image_data)
    {
         ...
    }

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://11139959]
Approved by LanX
Front-paged by LanX
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (5)
As of 2022-06-30 19:47 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My most frequent journeys are powered by:









    Results (98 votes). Check out past polls.

    Notices?