velPaint

#!/opt/local/bin/perl -w

# Velocity Painting by [Mark Wheadon](https://github.com/MarkWheadon) is licensed under a [Creative Commons Attribution 4.0
# International License](http://creativecommons.org/licenses/by/4.0/).
# Based on a work at https://github.com/MarkWheadon/velocity-painting.

use strict;
use warnings;
use 5.10.1;

our $VERSION = 0.4;
use Math::Trig;
use Imager;

unless ((@ARGV > 0) &&
   ((($ARGV[0] =~ /^-project[XYZ]$/ || $ARGV[0] eq '-spherical') && @ARGV >= 10) ||
   ($ARGV[0] eq '-cylinderZ' && @ARGV >= 9))) {
	print STDERR <<END;
Usage:
  $0 -projectX  printCentreX printCentreY imageWidth imageHeight zOffset targetSpeed lowSpeed highSpeed imageFile [sourceGcodeFile] > paintedGcodeFile
  $0 -projectY  printCentreX printCentreY imageWidth imageHeight zOffset targetSpeed lowSpeed highSpeed imageFile [sourceGcodeFile] > paintedGcodeFile
  $0 -projectZ  printCentreX printCentreY imageWidth imageHeight zOffset targetSpeed lowSpeed highSpeed imageFile [sourceGcodeFile] > paintedGcodeFile
  $0 -cylinderZ printCentreX printCentreY            imageHeight zOffset targetSpeed lowSpeed highSpeed imageFile [sourceGcodeFile] > paintedGcodeFile
  $0 -spherical printCentreX printCentreY xOffset    yOffset     zOffset targetSpeed lowSpeed highSpeed imageFile [sourceGcodeFile] > paintedGcodeFile

printCentre{X,Y} is the centre of the print in the printer's coordinate space, in mm.
-projectX projects the image onto the X axis as if the X axis were a cinema screen.
-projectY and -projectZ are similar, so use -projectZ to project onto the top/bottom of the model.
-cylinderZ wraps the image around the Z axis: great for vases.
-spherical projects outwards from the origin, offset by {x,y,z}Offset
When the print in centred on the bed then printCentre{X,Y} is 0,0 for most (all?) detas. 125,105 for the Prusa i3 MK2.
imageWidth and imageHeight and the offsets are all in mm.
Specifying an imageWith of '-' sets it to the correct width for the specified height.
Specifying an imageHeight of '-' sets it to the correct height for the specified width.
targetSpeed is the speed of the vectors you wish to manipulate
(so slice the model with all speeds set to this value).
lowSpeed is the required speed for the slow parts of the print
highSpeed is the required speed for the quick parts of the print
imageFile is the image to be mapped onto the print.

All speeds above are in mm/min.
END
	exit 1;
}

my $projectionMode = shift @ARGV;
my $projectedImageWidth;

my $printCentreX = shift @ARGV;
my $printCentreY = shift @ARGV;

if ($projectionMode =~ /^-project[XYZ]$/) {
	$projectedImageWidth = shift @ARGV;
}

my $projectedImageHeight;
my $xOffset;
my $yOffset;
if ($projectionMode eq '-spherical') {
	$xOffset = shift @ARGV;
	$yOffset = shift @ARGV;
} else {
	$projectedImageHeight = shift @ARGV;
}
my $zOffset = shift @ARGV;

my $targetSpeed = shift @ARGV;
my $lowSpeed = shift @ARGV;
my $highSpeed = shift @ARGV;
my $imageFile = shift @ARGV;

my $colourImage = Imager->new(file=>$imageFile) or die Imager->errstr();
my $image = $colourImage->convert(preset=>'grey');

my $imageWidth = $image->getwidth();
my $imageHeight = $image->getheight();
my $speedRange = $highSpeed - $lowSpeed;

if (($projectionMode ne '-spherical') && ((($projectionMode eq '-cylinderZ') || $projectedImageWidth eq '-') && $projectedImageHeight eq '-')) {
	print STDERR <<END;
$0: you must set either the image width or its height, or both.
END
	exit 1;
}

if (defined $projectedImageWidth && $projectedImageWidth eq '-') {
	$projectedImageWidth = $projectedImageHeight * $imageWidth / $imageHeight;
}

if (defined $projectedImageHeight && $projectedImageHeight eq '-') {
	$projectedImageHeight = $projectedImageWidth * $imageHeight / $imageWidth;
}

my $maxVecLength = .1; # Longest vector in mm. Splits longer vectors. Very small -> long processing times.

my ($oldX, $oldY, $oldZ, $oldE);
my $currentZ;
my $lastZOutput = -1;
my $extrudeAbsolute = 1;

while (my $line = <>) {
	my ($x, $y, $z, $e, $f);

	chomp $line;
	$line =~ s/\r//g;

	if ($line =~ /G1 X(?<x>\S+) Y(?<y>\S+)(?: Z(?<z>\S+))? E(?<e>\S+)(?: F(?<f>$targetSpeed))?$/ ||
	  $line =~ /G1 Z(?<z>\S+) X(?<x>\S+) Y(?<y>\S+) E(?<e>\S+)(?: F(?<f>$targetSpeed))?$/)
	{
		($x, $y, $z, $e, $f) = @+{qw/x y z e f/};
	}

	if ($line =~ /M82/) { $extrudeAbsolute = 1; }
	if ($line =~ /M83/) { $extrudeAbsolute = 0; }

	if (defined $z) { $currentZ = $z } else { $z = $currentZ; }

	if (defined $x) {
		if (!defined $oldZ) {
			outMove($x, $y, $z, $e, 0);
		} else {
			my $xd = $x - $oldX;
			my $yd = $y - $oldY;
			my $zd = $z - $oldZ;
			my $ed = $extrudeAbsolute ? ($e - $oldE) : $e;

			my $length = sqrt($xd * $xd + $yd * $yd + $zd * $zd);

			if ($length <= $maxVecLength) {
				outMove($x, $y, $z, $e, 0);
			} else {
				my $lastSegOut = 0;
				my $oSlow = surfaceSpeed($oldX, $oldY, $oldZ);

				my $nSegs = int($length / $maxVecLength + 0.5);

				my $xDelta = $xd / $nSegs;
				my $yDelta = $yd / $nSegs;
				my $zDelta = $zd / $nSegs;
				my $eDelta = $ed / $nSegs;

				for (my $i = 1; $i <= $nSegs; $i++) {
					my $nx = $oldX + $xDelta * $i;
					my $ny = $oldY + $yDelta * $i;
					my $nz = $oldZ + $zDelta * $i;

					my $slow = surfaceSpeed($nx, $ny, $nz);

					if (($slow != $oSlow) && ($i > 1)) {
						# pattern has changed. Time to output the vector so far
						outMove($oldX + $xDelta * ($i - 1),
						  $oldY + $yDelta * ($i - 1),
						  $oldZ + $zDelta * ($i - 1),
						  $extrudeAbsolute ? ($oldE + $eDelta * ($i - 1)) : ($eDelta * ($i - $lastSegOut)), 1);
						$oSlow = $slow;
						$lastSegOut = $i;
					}
				}
				if ($lastSegOut != $nSegs) {
					outMove($x, $y, $z, $extrudeAbsolute ? $e : ($eDelta * ($nSegs - $lastSegOut)), $lastSegOut != 0);
				}
			}
		}
		($oldX, $oldY, $oldZ, $oldE) = ($x, $y, $z, $e);
	} else {
		if ($line =~ /G1 X(\S+) Y(\S+) Z(\S+)/) {
			($oldX, $oldY, $oldZ) = ($1, $2, $3);
		} elsif ($line =~ /G1 X(\S+) Y(\S+)/) {
			($oldX, $oldY) = ($1, $2);
		}
		if ($line =~ /Z([\d\.]+)/) {
			$currentZ = $1;
			$oldZ = $1;
		} 
		if ($line =~ /E([\d\.]+)/) {
			$oldE = $1;
		}
		print "$line\n";
	}
}

sub surfaceSpeed {
	if ($projectionMode eq '-cylinderZ') {
		return surfaceSpeedCylinderZ(@_);
	} elsif ($projectionMode eq '-projectX') {
		return surfaceSpeedProjectX(@_);
	} elsif ($projectionMode eq '-projectY') {
		return surfaceSpeedProjectY(@_);
	} elsif ($projectionMode eq '-projectZ') {
		return surfaceSpeedProjectZ(@_);
	} elsif ($projectionMode eq '-spherical') {
		return surfaceSpeedSpherical(@_);
	}
}

sub outsideImage {
	my ($imageX, $imageY) = @_;
	return $imageX < 0 || $imageX >= $imageWidth || $imageY < 0 || $imageY >= $imageHeight;
}

sub surfaceSpeedCylinderZ {
	my ($x, $y, $z) = @_;

	my $zNormalized = ($z - $zOffset) / $projectedImageHeight;

	my $theta = atan2($y - $printCentreY, $x - $printCentreX) + pi; # 0 to 2pi
	my $xNormalized = $theta / (2 * pi);

	my $imageX = $xNormalized * $imageWidth;
	my $imageY = $imageHeight - $zNormalized * $imageHeight;

	if (outsideImage( $imageX, $imageY )) {
		return $highSpeed;
		# return $lowSpeed;
	}

	return $lowSpeed + greyAt($imageX, $imageY) * $speedRange;
}

sub surfaceSpeedProjectX {
	my ($x, $y, $z) = @_;

	my $xNormalized = ($x - $printCentreX + $projectedImageWidth / 2) / $projectedImageWidth;
	my $zNormalized = ($z - $zOffset) / $projectedImageHeight;

	my $imageX = $xNormalized * $imageWidth;
	my $imageY = $imageHeight - $zNormalized * $imageHeight;

	if (outsideImage( $imageX, $imageY )) {
		# return $highSpeed;
		return $lowSpeed;
	}

	return $lowSpeed + greyAt($imageX, $imageY) * $speedRange;
}

sub surfaceSpeedProjectY {
	my ($x, $y, $z) = @_;

	my $xNormalized = ($y - $printCentreY + $projectedImageWidth / 2) / $projectedImageWidth;
	my $zNormalized = ($z - $zOffset) / $projectedImageHeight;

	my $imageX = $xNormalized * $imageWidth;
	my $imageY = $imageHeight - $zNormalized * $imageHeight;

	if (outsideImage( $imageX, $imageY )) {
		# return $highSpeed;
		return $lowSpeed;
	}

	return $lowSpeed + greyAt($imageX, $imageY) * $speedRange;
}

sub surfaceSpeedProjectZ {
	my ($x, $y, $z) = @_;

	my $xNormalized = ($x - $printCentreX + $projectedImageWidth / 2) / $projectedImageWidth;
	my $yNormalized = ($y - $printCentreY + $projectedImageHeight / 2) / $projectedImageHeight;

	my $imageX = $xNormalized * $imageWidth;
	my $imageY = $yNormalized * $imageHeight;

	if (outsideImage( $imageX, $imageY )) {
		# return $highSpeed;
		return $lowSpeed;
	}

	return $lowSpeed + greyAt($imageX, $imageY) * $speedRange;
}

sub surfaceSpeedSpherical() {
	my ($x, $y, $z) = @_;

	my $theta = atan2($y - $yOffset - $printCentreY, $x - $xOffset - $printCentreX) + pi; # 0 to 2pi
	my $xNormalized = $theta / (2 * pi);

	$theta = atan2($z - $zOffset, $x - $xOffset - $printCentreX) + pi; # 0 to 2pi
	my $zNormalized = $theta / (2 * pi);

	my $imageX = $xNormalized * $imageWidth;
	my $imageY = $imageHeight - $zNormalized * $imageHeight;

	if ($imageX < 0 || $imageX >= $imageWidth || $imageY < 0 || $imageY >= $imageHeight) {
		return $highSpeed;
		# return $lowSpeed;
	}

	return $lowSpeed + greyAt($imageX, $imageY) * $speedRange;
}

sub greyAt {
	my ($x, $y) = @_;
	my $colours = $image->getpixel(x=>$x, y=>$y, type=>'float');
	my ($r, $g, $b, $a) = $colours->rgba();

	return $r;
}

sub outMove {
	my ($x, $y, $z, $e, $extra) = @_;

	my $zCommand = "";
	if ($z != $lastZOutput) { $zCommand = sprintf(" Z%.3f", $z); }

	my $added = ""; if ($extra) { $added = " ; added"; }

	printf("G1 X%.3f Y%.3f$zCommand E%.4f F%.3f$added\n", $x, $y, $e, surfaceSpeed($x, $y, $z));
	$lastZOutput = $z;
}