shanty 3-4 / usr / bin / shanty

#! /usr/bin/perl -w

# Copyright (c) 2002-2004, Duncan Martin (www.codebunny.org)
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without 
# modification, are permitted provided that the following conditions are met:
#
#     * Redistributions of source code must retain the above copyright notice, 
# this list of conditions and the following disclaimer.
#     * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#     * Neither the name of the software nor the names of its contributors may
# be used to endorse or promote products derived from this software without
# specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.

# Shanty v3
# http://www.codebunny.org/coding/shanty/
# Produces a postscript file from an image file and a text file.
# Written by Duncan Martin 

# libraries
use strict;

# -- function declarations
sub debug($);
sub error($);
sub getSwitches();

# -- constants

# page size lookups
# key is the lower case name, which is searched for my the -s switch
# the value is name to be used for paper size declaration in the output, and
# then the width and height in points.
my %PAGE_SIZE = (
	'a0'		=> "A0,2380,3368",
	'a1'		=> "A1,1684,2380",
	'a2'		=> "A2,1190,1684",
	'a3'		=> "A3,842,1190",
	'a4'		=> "A4,595,842",
	'a5'		=> "A5,421,595",
	'a6'		=> "A6,297,421",
	'letter'	=> "Letter,612,792",
	'broadsheet'	=> "Broadsheet,1296,1584",
	'ledger'	=> "Ledger,1224,792",
	'tabloid'	=> "Tabloid,792,1224",
	'legal'		=> "Legal,612,1008",
	'executive'	=> "Executive,522,756",
	'36x36'         => "36x36,2592,2592"
);

# -- globals

# overridable defaults
my $altGd	= 0;
my $bottomToTop	= 0;
my $chosenSize;
if(open(FILE,"/etc/papersize")){
	$chosenSize = <FILE>;
	chomp($chosenSize);
}
else{
	$chosenSize = "a4";
}
my $density	= 1.4;
my $font	= "Courier-Bold";
my $margin	= 1;
my $orientation	= "Auto";
my $rightToLeft	= 0;
my $shade	= 0;
my $shadeMargin	= 0.5;
my $title	= "Shanty output";

# globlas which will be set later
my $imageFile	= "";
my $outputFile	= "";
my $shadeBlue;
my $shadeGreen;
my $shadeRed;
my $textFile	= "";

# -- program start

# get options specified on the command line
getSwitches();

# include GD
unless ($altGd) {
	require GD;
	import GD;

} else {
	require GD::Image;
	import GD::Image;
}

# say hello
print STDERR "Shanty v3\n";
print STDERR "Written by Duncann Martin\n";
print STDERR "http://www.codebunny.org/coding/shanty/\n\n";
print STDERR "Image file: $imageFile\n";
print STDERR "Text file: ";
if ($textFile eq "") {
	print STDERR "STDIN\n";
} else {
	print STDERR $textFile,"\n";
}
print STDERR "Output file: ";
if ($outputFile eq "") {
	print STDERR "STDOUT\n";
} else {
	print STDERR $outputFile,"\n";
}
print STDERR "Paper size: $chosenSize\n";
print STDERR "Margin: ${margin}cm\n";
print STDERR "Orientation: $orientation\n";
print STDERR "Print density: ${density}\n";
print STDERR "Background: ";
if (!$shade) {
	print STDERR "none\n";
} else {
	print STDERR "$shadeRed,$shadeGreen,$shadeBlue\n";
	print STDERR "Background margin: ${shadeMargin}cm\n";
}

# open and get image file
if (!-r $imageFile) {
	error("couldn't read image file");
}
if ((lc $imageFile) !~ (/\.([a-z]+)$/g)) {
	error("couldn't work out image file extension");
}
my $extension = $1;
my $imageHandle;

# compare extension to find image file type, then load in
# for PNG files
my $transparent = -1;
if ($extension eq "png") {
	$imageHandle	= newFromPng GD::Image($imageFile);
	$transparent	= $imageHandle->transparent(); 

# for JPG files
} elsif (($extension eq "jpg") || ($extension eq "jpeg")) {
	$imageHandle = newFromJpeg GD::Image($imageFile);

# otherwise return an error
} else {
	error("files of type '$extension' are not supported, please use PNG or JPG");
}

# error check
if (!$imageHandle) {
	error("failed to load '$imageFile'");
}

# try to get input
my $textHandle;
my $allText	= "";

# for stdin
if ($textFile eq "") {
	$textHandle 	= *STDIN{IO};
	print STDERR "> waiting for STDIN....\n";
} else {
	open $textHandle, $textFile or error("couldn't open text file");
}

# read eveything from the file
while (<$textHandle>) {
	$allText .= $_;
}

# close the file
if ($textFile ne "") {
	close $textHandle;
}

# turn all white-spaces to a maximum one space
$allText =~ s/\s+/ /g;

# open the file for writing
my $outputHandle;

# for stdin
if ($outputFile eq "") {
	$outputHandle 	= *STDOUT{IO};
} else {
	open $outputHandle, "> $outputFile" or error("couldn't open output file");
}

# declare as postscript
print $outputHandle "%!PS-Adobe-2.0\n";

# Now get the dimensions of the picture
my ($xSize,$ySize) = $imageHandle->getBounds();
print STDERR "> picture size:  ${xSize}x${ySize}\n";

# presume portrait for now
my ($psPageSize, $pointWidth, $pointHeight) = split ",", 
	$PAGE_SIZE{$chosenSize};
	
print STDERR "> paper size: ${pointWidth}x${pointHeight}points\n";

# if orientation is automatic, work out what's best
if ($orientation eq "Auto") {
	if ($xSize > $ySize) {
		$orientation = "Landscape";
	} else {
		$orientation = "Portrait";
	}
	print STDERR "> orientation: $orientation\n";
}

# flip dimensions if landscape
if ($orientation eq "Landscape") {
	my $a = $pointWidth;
	$pointWidth	= $pointHeight;
	$pointHeight	= $a;
	$psPageSize	.= "l";
}

# work out if the page sizes when considering the margin
my $eWidth	= $pointWidth 	- ($margin * 144) / 2.54;
my $eHeight 	= $pointHeight	- ($margin * 144) / 2.54;

# find which dimension is the limiting factor
my $fontSize;
if (($eWidth / $xSize) < ($eHeight / $ySize)) {
	$fontSize = $eWidth / $xSize;
} else {
	$fontSize = $eHeight / $ySize;
}
print STDERR "> font size: ${fontSize}points\n";

# work out the corner positions
my ($left, $right, $top, $bottom);
my $realWidth	= $fontSize * $xSize;
$left		= ($pointWidth - $realWidth) / 2;
$right		= $pointWidth - $left;

my $realHeight	= $fontSize * $ySize;
$bottom		= (($pointHeight - $realHeight) / 2);
$top		= $pointHeight - $bottom;

# text starting positions
my $xStart	= $left;
my $yStart	= $top - $fontSize;

# override for right-to-left text
if ($rightToLeft) {
	$xStart	= $right - $fontSize;
}

# override for bottom-to-top text
if ($bottomToTop) {
	$yStart	= $bottom;
}

# declare document size in postscript
print $outputHandle <<EOF;
\%\%Title: $title
\%\%Creator: Shanty v3 - http://www.codebunny.org/coding/shanty/
\%\%DocumentPaperSizes: custom
\%\%DocumentMedia: $psPageSize $pointWidth $pointHeight 80 white ( )
\%\%Orientation: Portrait
\%\%Pages: 1
\%\%EndComments

\%\%BeginDefaults
\%\%PageMedia: $psPageSize $pointWidth $pointHeight 80 white ( )
\%\%PageOrientation: Portrait
\%\%EndDefaults

<< /PageSize [$pointWidth $pointHeight] >> setpagedevice

EOF

# change to specified font
print $outputHandle "/$font findfont\n";

# set the point size
print $outputHandle $fontSize*$density," scalefont setfont\n";

print STDERR "> starting y: $yStart\n> starting x: $xStart\n";

# store the y position
print $outputHandle "/ypos $yStart def\n";

# choose x axis movement
my $moveX	= "add";
$moveX		= "sub" if ($rightToLeft);

# choose y axis movement
my $moveY	= "sub";
$moveY		= "add" if ($bottomToTop);

# define the procedure to print one char
print $outputHandle "/onechar { xpos ypos moveto show /xpos xpos ";
print $outputHandle "$fontSize $moveX def} def\n";

# define the procedure to skip a char
print $outputHandle "/skipchar { /xpos xpos $fontSize $moveX def} def\n";

# draw the backing box
if ($shade) {
	$shadeRed /= 255;
	$shadeGreen /= 255;
	$shadeBlue /= 255;
	my $shadeMar = ($shadeMargin * 72) / 2.54;
	my $shadeWidth	= ($shadeMar * 2) + $realWidth;
	my $shadeHeight = ($shadeMar * 2) + $realHeight;
	my $shadeX	= $left - $shadeMar;
	my $shadeY	= $top + $shadeMar; 
	print $outputHandle <<EOF;
$shadeRed $shadeGreen $shadeBlue setrgbcolor
newpath
$shadeX $shadeY moveto
$shadeWidth 0 rlineto
0 -$shadeHeight rlineto
-$shadeWidth 0 rlineto
0 $shadeHeight rlineto
fill
EOF
}

# get the length of the text, and set the counter to 0
my $textOffset = 0;
my $textLen	= length $allText;

# set the last colour seen to something impossible
my ($lastRed, $lastGreen, $lastBlue) = (-1, -1, -1);

# set the initial y position
print $outputHandle "/ypos $yStart def\n";

# loop for all pixels
for (my $yScan = 0; $yScan < $ySize; $yScan++) {
	my $pys = $yScan;
	$pys = $ySize - 1 - $yScan if ($bottomToTop);

	# set the x position to the start of the line
	print $outputHandle "/xpos $xStart def\n";

	# scan through the horizontal line
	for (my $xScan = 0; $xScan < $xSize; $xScan++) {
		my $pxs	= $xScan;
		$pxs	= $xSize - 1 - $xScan if ($rightToLeft);
	
		# get a single character of text
		my $char = substr($allText, $textOffset, 1);
		
		# adjust the character to keep it nice and legal
		$char =~ s/\\/\\\\/go;
		$char =~ s/\//\\\//go;
		$char =~ s/\(/\\\(/go;
		$char =~ s/\)/\\\)/go;

		# get the colour from the image
		my $colIndex = $imageHandle->getPixel($pxs,$pys);
    	    	my ($red,$green,$blue) = $imageHandle->rgb($colIndex);

		# if this colour is transparent, skip on
		if ($colIndex == $transparent) {
			print $outputHandle "skipchar\n";
			next;
		}		
		
		# if this is too close to white, and we don't have
		# a background shade, just move on
		if (!$shade && (($red + $green + $blue) > 750)) {
			print $outputHandle "skipchar\n";
			next;
		}
		
		# turn the RGB colour into PS style colour		
		$red /= 255;
		$green /= 255;
		$blue /= 255;

		if (($red != $lastRed) || ($green != $lastGreen) ||
			($blue != $lastBlue)) {
			
			print $outputHandle "$red $green $blue setrgbcolor\n";
			$lastRed	= $red;
			$lastGreen	= $green;
			$lastBlue	= $blue;
		}
		
		# call the routine to print a character
		print $outputHandle "($char) onechar\n";
		
		# move the text counter along, if at the end of the string
		# go back to the start
		$textOffset++;
		if ($textOffset >= $textLen) {
			$textOffset = 0;
		}
	} 
	
	# move the y position down a line
	print $outputHandle "/ypos ypos $fontSize $moveY def\n";
}


# show the page
print $outputHandle "showpage\n";

# close the file
if ($outputFile ne "") {
	close $outputHandle;
}

# we're done, thank you, it's been a pleasure.
exit(0);

# ------------------------
# function definitions

# debug line
sub debug($) {
	my $line	=  $_[0];
	$line		=~ s/\s*\n\s*/ /g;

	print STDERR "debug: $line\n";

	1;
} # end of 'debug()'
	
# general error
sub error($) {
	my $line	=  $_[0];
	$line		=~ s/\s*\n\s*/ /g;

	print STDERR "error> $line\n";

	exit(-1);
} # end of 'error()'

# get input switches
sub getSwitches() {
	my $numArgs	= @ARGV;
	my $scan	= 0;
	my $switch;
	my %seen;
	
	my @args	= @ARGV;

	while (@args) {
		my $arg	= shift @args;
		
		# check this is a switch
		unless ($arg =~ /^--?([a-z]+)$/) {
			error("found \"$arg\" when looking for switch");
		}
		my $switch	= lc $1;
		
		# check for duplicate switches
		if ($seen{$switch}) {
			error("switch \"$switch\" specified twice");
		}
		$seen{$switch}++;
		
		# unary switches
		# right-to-left text
		if ($switch eq "rtl") {
			$rightToLeft	= 1;
			next;
		
		# bottom-to-top text	
		} elsif ($switch eq "btt") {
			$bottomToTop	= 1;
			next;
			
		# alt GD method
		} elsif ($switch eq "altgd") {
			$altGd	= 1;
			next;
		
		}
		
		# must be a binary switch, so get data
		unless (@args) {
			error("no data after switch \"$switch\"");
		}
		my $data	= shift @args;
		
		# check it's not another switch
		if ($data =~ /^--?([a-z]+)$/) {
			error("no data after switch \"$switch\"");
		}
				
		$data		=~ s/^"//g;
		$data		=~ s/"$//g;
		
		$seen{$switch}++;

		# input image
		if (($switch eq "i") || ($switch eq "image")) {
			$imageFile	= $data;
			
		# output file
		} elsif (($switch eq "o") || ($switch eq "output")) {
			$outputFile	= $data;
			
		# text file
		} elsif (($switch eq "t") || ($switch eq "text")) {
			$textFile	= $data;
		
		# page size
		} elsif (($switch eq "s") || ($switch eq "size")) {
		
			$chosenSize = lc $data;
			if (!exists $PAGE_SIZE{$chosenSize}) {
				error("unknown page size: \"$chosenSize\"");
			}
		
		# margin	
		} elsif (($switch eq "m") || ($switch eq "margin")) {
			unless ($data =~ /^[\d\.]+$/) {
				error("invalid margin: \"$data\"");
			}
			
			$margin		= $data;
			
		# density
		} elsif (($switch eq "d") || ($switch eq "density")) {
			unless ($data =~ /^[\d\.]+$/) {
				error("invalid density: \"$data\"");
			}
			
			$density	= $data;
		
		# background shading	
		} elsif (($switch eq "b") || ($switch eq "background")) {
			if (lc $data eq "off") {
				$shade	= 0;
				next;
			}
			
			unless ($data =~ /^([\d]+),([\d]+),([\d]+)$/) {
				error("invalid background shading value:
					\"$data\"");
				
			}


			if (($1 > 255) || ($2 > 255) || ($3 > 255)) {
				error("RGB values for backfround shading must
					be 0-255");
					
			}
			
			$shadeRed	= $1;
			$shadeGreen	= $2;
			$shadeBlue	= $3;
			$shade		= 1;
			
		# padding
		} elsif (($switch eq "x") || ($switch eq "p") ||
			($switch eq "padding")) {
			
			unless ($data =~ /^[\d\.]+$/) {
				error("invalid padding: \"$data\"");
			}
			
			$shadeMargin	= $data;
			
		# orientation
		} elsif (($switch eq "l") || ($switch eq "orientation")) {
			my $lcd	= lc $data;
		
			if (($lcd eq "p") || ($lcd eq "portrait")) {	
				$orientation = "Portrait";
				
			} elsif (($lcd eq "l") || ($lcd eq "landscape")) {
				$orientation = "Landscape";
				
			} elsif (($lcd eq "a") || ($lcd eq "auto")) {
				$orientation = "Auto";
				
			} else {
				error("unknown orientation: \"$lcd\"");
				
			}
			
		# PS title
		} elsif (($switch eq "n") || ($switch eq "title")) {
			$title = $data;
			
		# font
		} elsif (($switch eq "f") || ($switch eq "font")) {
			$font	= $data;
				
		# unknown
		} else {
			error("unknown switch \"$switch\"");
			
		}

	}
	
	# image file compulsory
	if (!$seen{"i"}) {
		error("no image file specified");
	}	

} # end of 'getSwitches()'