Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

gd_tiler using GD to create tiled images

by Discipulus (Canon)
on Dec 03, 2022 at 16:47 UTC ( [id://11148530]=CUFP: print w/replies, xml ) Need Help??

Hello folks!

..since its raining.. :) inspired by my own challenge (yes: I feel brave enough!) I wrote a nice subroutine to tile images horizontally or vertically. No need to get more complicate: if you need a tiled 3x3 image just build up three times a 3x1 and use them to create the 3x3 one.

Being the space divided evenly, if you pass images very different in shape the result will be ugly to see, but the sub is as much as generic it can.

Resulting dimensions will be adjusted pixel by pixel until they become evenly divisible for the number of images processed: so if you ask to create an image with 899 as width and 3 images you'll get an image of 900 pixel width

Here the small test script containing the gd_tiler sub and few line of code. Pass please as @ARGV 3 images of approximately same shape (or modify the code as you need.. it is free ;)

use strict; use warnings; use GD; # for semplicity pass 3 images my @test_images = ($ARGV[0],$ARGV[1],$ARGV[2]); sub gd_tiler{ my %params = @_; my $width = $params{width} or die "Missing width (or zero)!"; my $hight = $params{height} or die "Missing height (or zero)!"; my $direction = $params{direction}; my $format = defined $params{format} ? $params{format} : 'jpeg'; my $filename = $params{filename} or die "Missing filename for outp +ut image"; my @images = ref $params{images} eq 'ARRAY' ? @{$params{images}} : die "Images should be passed as array reference!"; my $verbosity = $params{verbosity}; # offset used after my $woffset = 0; my $hoffset = 0; # adjust for horizontal tiling if ( $direction =~ /^h/i){ unless ( int($width / scalar @images) == ($width / scalar @ima +ges) ){ $width++ until int($width / scalar @images) == ($width / s +calar @images); print "Adjusted width to $width..\n" if $verbosity; $woffset = ($width / scalar @images); } $direction = 'h'; } # adjust for vertical tiling elsif ( $direction =~ /^v/i ){ unless ( int($hight / scalar @images) == ($hight / scalar @ima +ges) ){ $hight++ until int($hight / scalar @images) == ($hight / s +calar @images); print "Adjusted hight to $hight..\n" if $verbosity; $hoffset = ($hight / scalar @images); } $direction = 'v'; } else { die "Unrecognized direction [$direction]! Should be 'horizo +ntal' or 'vertical'" } print "New image $filename ($width x $hight) will be tiled ", ( $direction eq 'v' ? "vertically" : "horizontally" ), " using ",scalar @images," images\n" if $verbosity; # default to truecolor GD::Image->trueColor(1); # resulting GD image my $gdtiled = GD::Image->new($width, $hight); my $count = 0; foreach my $img( @images ){ die "Image [$img] not found!" unless -e $img; print "\nProcessing $img" if $verbosity; # transform into a GD object # automatically recognized: GIF, PNG, JPEG, XBM, XPM, GD2, TIF +F, WEBP, HEIF or AVIF $img = GD::Image->new($img); my $dstX = 0 + $woffset; my $dstY = 0 + $hoffset; my $srcX = 0; my $srcY = 0; my $destW = $direction eq 'h' ? ($width / scalar @images) : $width; my $destH = $direction eq 'v' ? ($hight / scalar @images) : $hight; my $srcW = $img->width(); my $srcH = $img->height(); if ( $verbosity ){ print " (",$img->width()," x ",$img->height(),")\n", "destX $dstX\n", "destY $dstY\n", "srcX $srcX\nsrcY $srcY\n", "destW $destW,\n", "destH $destH\n", "srcW $srcW\nsrcH $srcH\n"; } # https://metacpan.org/pod/GD#$image-%3EcopyResampled($sourceI +mage,$dstX,$dstY, $gdtiled->copyResampled( $img, $dstX, $dstY, $srcX, $srcY, $destW, $destH, $srcW, $srcH, ); last if $count == $#images; $count++; # increment offset if ( $direction eq 'h'){ $woffset += ($width / scalar @images); print "(adjusting width offset += ".($width / scalar @imag +es).")\n" if $verbosity; } else{ $hoffset += ($hight / scalar @images); print "(adjusting hight offset += ".($hight / scalar @ +images).")\n" if $verbosity; } } # write the output image open my $out, '>', $filename or die "Unable to open [$filename] fo +r writing!"; binmode $out; die "Unsupported GD method [$format]!" unless $gdtiled->can($forma +t); print $out $gdtiled->$format or die "Error printing $gdtiled into +$filename using $format!"; print "\nSuccesfully wrote $filename.\n\n" if $verbosity; } # horizontally gd_tiler( width => 900, height => 400, direction => 'h', format => 'jpeg', filename => 'tiled-horizontally.jpg', images => [ @test_images ], verbosity => 1, ); # vertically gd_tiler( width => 300, height => 1200, direction => 'v', format => 'jpeg', filename => 'tiled-vertically.jpg', images => [ @test_images ], verbosity => 1, ); # use the first one to build a 3x3 tiled gd_tiler( width => 900, height => 1200, direction => 'v', format => 'jpeg', filename => 'tiled-3x3.jpg', images => ['tiled-horizontally.jpg','tiled-horizon +tally.jpg','tiled-horizontally.jpg' ], verbosity => 1, );

If you are too lazy to run it, here the output calling the program as: perl gd-tiler01.pl uno.jpg DSCN0077.JPG uno.jpg

New image tiled-horizontally.jpg (900 x 400) will be tiled horizontall +y using 3 images Processing uno.jpg (300 x 400) destX 0 destY 0 srcX 0 srcY 0 destW 300, destH 400 srcW 300 srcH 400 (adjusting width offset += 300) Processing DSCN0077.JPG (3864 x 5152) destX 300 destY 0 srcX 0 srcY 0 destW 300, destH 400 srcW 3864 srcH 5152 (adjusting width offset += 300) Processing uno.jpg (300 x 400) destX 600 destY 0 srcX 0 srcY 0 destW 300, destH 400 srcW 300 srcH 400 Succesfully wrote tiled-horizontally.jpg. New image tiled-vertically.jpg (300 x 1200) will be tiled vertically u +sing 3 images Processing uno.jpg (300 x 400) destX 0 destY 0 srcX 0 srcY 0 destW 300, destH 400 srcW 300 srcH 400 (adjusting hight offset += 400) Processing DSCN0077.JPG (3864 x 5152) destX 0 destY 400 srcX 0 srcY 0 destW 300, destH 400 srcW 3864 srcH 5152 (adjusting hight offset += 400) Processing uno.jpg (300 x 400) destX 0 destY 800 srcX 0 srcY 0 destW 300, destH 400 srcW 300 srcH 400 Succesfully wrote tiled-vertically.jpg. New image tiled-3x3.jpg (900 x 1200) will be tiled vertically using 3 +images Processing tiled-horizontally.jpg (900 x 400) destX 0 destY 0 srcX 0 srcY 0 destW 900, destH 400 srcW 900 srcH 400 (adjusting hight offset += 400) Processing tiled-horizontally.jpg (900 x 400) destX 0 destY 400 srcX 0 srcY 0 destW 900, destH 400 srcW 900 srcH 400 (adjusting hight offset += 400) Processing tiled-horizontally.jpg (900 x 400) destX 0 destY 800 srcX 0 srcY 0 destW 900, destH 400 srcW 900 srcH 400 Succesfully wrote tiled-3x3.jpg.
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.

Replies are listed 'Best First'.
Re: gd_tiler using GD to create tiled images
by harangzsolt33 (Chaplain) on Jan 03, 2023 at 06:14 UTC
    Speaking of "reinventing the wheel" ... I wrote a few sub routines that perform the behind-the-scenes work of tiling. The TileImage() and CenterTile() functions will fill an area with a smaller image. These are part of a graphics module. I am not familiar with GD, but I wish there was a way to convert one format to another. My functions treat images as a single string which I call canvas object. The canvas object has a 16-byte header which contains the width and height of the image, and the rest of the bytes store the pixels R G B values which are accessible with vec() and substr() functions. I'm not sure how GD stores images in the memory. Is it an array, a string, a hash? If I understood the format, I could write a converter sub.

    ################################################## # Canvas | Graphics | v2022.12.19 # This function will tile an area defined by # Width x Height with an image referenced in the # first argument in such a way that the first tile # will be laid in the exact center of the new image. # Returns the reference to the new image or # returns zero if an error occurs. # # Usage: NEW_IMAGE_REF = CenterTile(CANVASREF, Width, Height) # sub CenterTile { my ($TILE, $W, $H, $D) = UseCanvas($_[0]) or return 0; my $NewWidth = IntRange($_[1], 0, 4294967295); my $NewHeight = IntRange($_[2], 0, 4294967295); my $CenterX = ($NewWidth - $W) >> 1; my $CenterY = ($NewHeight - $H) >> 1; my $Y = ($H < $NewHeight) ? $H - ($CenterY % $H) : ($H - $NewHeight) >> 1; my $X = ($W < $NewWidth) ? $W - ($CenterX % $W) : ($W - $NewWidth) >> 1; return TileImage($_[0], $NewWidth, $NewHeight, $X, $Y); } ################################################## # Canvas | Graphics | v2022.12.19 # This function will tile an area using an image # referenced in the first argument to build a new # image. Returns a reference to the new image or zero... # # Usage: NEW_CANVAS_REF = TileImage(CANVASREF, Width, Height, X, Y) # # The caller specifies the size of the output image # in pixels (Width and Height). Imagine this as a window # that allows you to see the tiles below. Using the # X and Y coordinates, we can shift this window right # and down by a tiny amount to change the alignment # of the tile patterns visible in the window. # For example, we could align the window so that one # tile image appears in the exact center of the window. # The CenterTile() does exactly that by calculating # the right X and Y offsets to align the tile image # perfectly in the center. # sub TileImage { my ($TILE, $W, $H, $D, $BASE) = UseCanvas($_[0]) or return 0; my $NewWidth = IntRange($_[1], 0, 4294967295); my $NewHeight = IntRange($_[2], 0, 4294967295); my $TileX = IntRange($_[3], 0, $W); my $TileY = IntRange($_[4], 0, $H); if ($W == 0 || $H == 0) { GPRINT("Tile image is too small."); return BlankCanvas($D); } if ($NewWidth == 0 || $NewHeight == 0) { GPRINT("Output image is too small."); return BlankCanvas($D); } GPRINT("\nTileImage(): Creating $NewWidth x $NewHeight x ", ($D << 3), " image using $W x $H tiles... "); # Create the new canvas and reserve all the memory we will need. my $NEW = CreateCanvasHeader($NewWidth, $NewHeight, $D); my $LAST = $NewWidth * $NewHeight * $D + 15; vec($NEW, $LAST, 8) = 0; # If we're showing only part of the first tile with TileY being # greater than zero, then we need to use the same start offset # for the entire width of the image. So, after we're done copying # the first tile, we need to reset YOffset to TileY. # However, after we have laid out the first row of tiles, we # reset YOffset to zero to start copying tiles from line 0. # YReset holds the line counter after which we must # reset YOffset to zero: my $YReset = $H - $TileY - 1; my $YOffset = $TileY; # Current line we're copying from the tile. # Calculate width of the first tile: my $LeftEdge = ($TileX) ? $W - $TileX : 0; # ...in pixels my $LLEN = $LeftEdge * $D; # ...in bytes my $LOFFSET = $TileX * $D; # This is the X start offset (byte ptr) my $TLEN = $W * $D; # This is the width of one full tile in bytes # Calculate number of whole tiles we can fit in a row. # We will call this the center isle. my $REP = int(($NewWidth - $LeftEdge) / $W); # Calculate the width of the center isle: my $CenterWidth = $REP * $W; # in pixels my $CLEN = $CenterWidth * $D; # in bytes # Calculate width of the last tile in a row: my $RightEdge = $NewWidth - $LeftEdge - $CenterWidth; # in pixels my $RLEN = $RightEdge * $D; # in bytes my $TO = $BASE; # This is the destination byte pointer. # BASE holds the size of the canvas header, which is 16 bytes. # We must skip over that. We don't want to overwrite the header, # and ruin the output image. # To calculate the tile pointer, we multiply YOffset by the # TileWidth and add TileX which is the horizontal offset, # then multiply by $D (bytes per pixel) and add $BASE, # which is the canvas header length of the tile. # To speed things up a bit, we perform the multiplications # outside of the loop and only do + and - inside the loop: my $TBASE1 = $TileX * $D + $BASE; # Ptr to 1st row of tile my $TBASE2 = $TBASE1 + $YOffset * $TLEN; # Ptr to YOffset row my $NEXT = $TLEN + $LOFFSET; # Go to next tile line (optimization) # Calculate exact byte pointer for reading the first tile. my $FROM = $TBASE2; for (my $Y = 0; $Y < $NewHeight; $Y++) { # We copy the tile line by line. YOffset tells us which line # we're copying right now. Once we're done copying all lines # of the tile, we reset YOffset and start over. # Does the left side of the image start with a partial tile? if ($LLEN) { substr($NEW, $TO, $LLEN) = substr($$TILE, $FROM, $LLEN); $TO += $LLEN; } # Are there any whole tiles we need to copy? $FROM -= $LOFFSET; if ($CLEN) { substr($NEW, $TO, $CLEN) = substr($$TILE, $FROM, $TLEN) x $REP; $TO += $CLEN; } if ($RLEN) # Is there a partial tile on the right edge? { substr($NEW, $TO, $RLEN) = substr($$TILE, $FROM, $RLEN); $TO += $RLEN; } $FROM += $NEXT; # Jump to next line of tile if (++$YOffset >= $H) # Completely finished copying one tile? { if ($Y < $YReset) # Done with first row of tiles? { $YOffset = $TileY; $FROM = $TBASE2; } # No else { $YOffset = 0; $FROM = $TBASE1; } # Yes } } return \$NEW; } ################################################## # 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] && ref($_[0]) eq 'SCALAR' or return 0; my $REF = $_[0]; defined $$REF && length($$REF) > 15 or return 0; substr($$REF, 0, 6) eq 'CANVAS' or return 0; return (index('08162432', substr($$REF, 6, 2)) & 1) ? 0 : $REF; } ################################################## # 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 $NUM = defined $_[0] ? int($_[0]) : $MIN; my $MAX = defined $_[2] ? int($_[2]) : 4294967295; use warnings; $NUM > $MIN or return $MIN; $NUM < $MAX or return $MAX; return int($NUM); } 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.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.12.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; no warnings; my $D = substr($$REF, 6, 2) >> 3; use warnings; return $D; } ################################################## # 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 in 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 = GetBPP($_[3]) || DepthOf($REF); FixCanvasHeader($REF, $W, $H, $D); my $SIZE = $W * $H * $D + 16; if (length($$REF) < $SIZE) { vec($$REF, $SIZE - 1, 8) = 0; } if (length($$REF) > $SIZE) { $$REF = substr($$REF, 0, $SIZE); } return 1; } ################################################## # Canvas | Graphics | v2022.12.13 # This function overwrites the first 16 bytes of a # string with a new canvas header. The first # argument must be a string reference! # # Usage: FixCanvasHeader(CANVASREF, Width, Height, [Depth]) # sub FixCanvasHeader { defined $_[0] && ref($_[0]) eq 'SCALAR' or return 0; my $REF = shift; defined $$REF or $$REF = ''; substr($$REF, 0, 16) = CreateCanvasHeader(@_); return 1; } ################################################## # Canvas | Graphics | v2022.12.13 # This function returns a new 16-byte canvas header # string which starts with the word 'CANVAS' and # contains the canvas width, height, and depth. # # This function will always return a valid canvas # header even if you provide invalid arguments. # # Usage: HEADER = CreateCanvasHeader(Width, Height, Depth) # sub CreateCanvasHeader { my $D = GetBPP($_[2], 3); # Convert image depth to bytes per pixel my $HEADER = sprintf('CANVAS%0.2d', $D << 3); vec($HEADER, 3, 32) = IntRange($_[1], 0, 4294967295); # Save height vec($HEADER, 2, 32) = IntRange($_[0], 0, 4294967295); # Save width return $HEADER; } ################################################## # Canvas | Graphics | v2022.12.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 or # the number of colors. This function always returns # the value in bytes per pixel. # This function returns the DEFAULT value if an # invalid depth is given. If a DEFAULT value is # not specified, then zero is the default value. # # Usage: BYTES_PER_PIXEL = GetBPP(DEPTH, [DEFAULT]) # sub GetBPP { my $D = IntRange($_[0], 0, 9999999999); if ($D == 1 || $D == 8 || $D == 256) { return 1; } if ($D == 2 || $D == 16 || $D == 65536) { return 2; } if ($D == 3 || $D == 24 || $D == 16777216) { return 3; } if ($D == 4 || $D == 32 || $D == 4294967296) { return 4; } return defined $_[1] ? $_[1] : 0; } ################################################## # Canvas | Graphics | v2022.12.13 # Creates another copy of a canvas in memory and # returns the new copy's reference. # Usage: CANVASREF2 = CloneCanvas(CANVASREF1) # sub CloneCanvas { my $REF = GetCanvasRef($_[0]) or return BlankCanvas(); my $NEW = $$REF; # Copy it return \$NEW; # Return reference to new copy } ################################################## # Canvas | Graphics | v2022.12.13 # Returns a reference to a 0 x 0 blank canvas. # Usage: CANVASREF = BlankCanvas([DEPTH]) # sub BlankCanvas { return NewCanvas(0, 0, $_[0]); } ################################################## # Canvas | Graphics | v2022.12.13 # This function completely erases a valid, already # existing canvas and changes its size to 0 x 0 pixels. # Usage: MakeBlank(CANVASREF, [DEPTH]) # sub MakeBlank { defined $_[0] && ref($_[0]) eq 'SCALAR' or return 0; my $REF = $_[0]; defined $$REF && length($$REF) > 15 or return 0; substr($$REF, 0, 6) eq 'CANVAS' or return 0; $$REF = CreateCanvasHeader(0, 0, $_[1]); return 1; } ################################################## # Canvas | Graphics | v2022.11.28 # Deletes one or more strings which are passed by # reference and frees up the memory. Returns the # number of items that were successfully erased. # Usage: COUNT = Cleanup(CANVASREF(s)...) # sub Cleanup { my $COUNT = 0; foreach (@_) { ref($_) eq 'SCALAR' or next; my $REF = $_; undef $$REF; $COUNT++; } return $COUNT; } ################################################## # Debugging | v2022.12.11 # This function is called whenever information or # error messages are printed by any of the graphics # routines in this library. This function can be # modified to print everything to stderr or to save # the messages to a file or suppress everything. # Usage: GPRINT(MSG) # sub GPRINT { print STDERR @_; } ##################################################

    I have already written these subs, so if we could connect GD with this format, we could use these interchangeably:

    InvertColors()
    Brightness()
    Contrast()
    Saturation()
    AdjustExposure()
    AdjustGamma()
    MosaicImage()
    SetPixel()
    GetPixel()
    DrawBox()
    DrawLine()
    DrawCircle()
    DrawGrid()
    FillCanvas()
    FlipHorizontal()
    FlipVertical()
    Flip90Degrees()
    RotateImage()
    ResizeImage()
    ResizeByPercentage()
    ResizeWidth()
    ResizeHeight()
    CropImage()
    ExpandImage()
    CopyWindow()
    PasteImage()
    StitchCanvas()
    FindImage()
    ReadChart()
    

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://11148530]
Approved by Athanasius
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others rifling through the Monastery: (6)
As of 2024-04-25 18:06 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found