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()
|