#!/usr/bin/perl -w

=head1 Gray Scale picture ASCII art Generator

Converts an uncompressed 24-bits TGA image to a gray scale ASCII art picture.
This script is very basic, so you have to take care of the following things in
your graphics application before you convert an image:

=over 4

=item scale for a fit on the medium of your choice (i.e. 80 columns for a
terminal)

=item adjust horizontal or vertical scaling to conserve aspect ratio with the
font of your choice

=back

The easiest way to do all this is to select a range in an image resembling the
area your medium can display and then resample it to the absolute width and
height that medium can handle. So, for a regular terminal screen take a 4:3
range and resample this to 80x25 pixels.

If you choose to fill the medium-width completely you can omit newlines using
the stream option to avoid newline characters being the 81st character to word
wrap. Another option is negative, for using light on dark media. The optimize
contrast option tries to use the whole character-palette, instead of just
mapping grays to a character, which hardly gets to use the bounderies of the,
already limited, palette. You can choose between different palettes or apply a
user defined palette.

=head2 ASCII palettes

An ASCII palette is a string containing the characters that represent different
shades of gray. Normally a true color image has up to 256 shades of gray, which
can't be mapped one on one to characters because there are only 96 printable
characters in the ASCII set. Also, not every character in the ASCII set has a
different shade of gray, which limits the available shades of gray to around 30
and mapping has to be done with ranges of about eigth shades to one character.
To avoid losing contrast the upper and lower bounds of the shades in an image
can be set to the upper and lower shade available in the palette. The shift in
overall brightness that is the result of this doesn't matter because the
brightness is already shifted: the heaviest character is not much more than
only half the area it occupies, so the image is made out of contrast, not the
brightness of the original image. Streching the contrast with the -c option
usually gives better results. Tinker with the different font options to get the
best results on different systems.

With the palette option you can define a string that represents an ASCII
palette. Enter the characters from darkest to lightest and use escape sequences
where nessecary. (Check with Getopt::Long on how to escape)

=head2 Aspect ratios

A regular computer screen is 4 units wide and 3 units high. Popular text modes
use 8x16 or 8x8 pixel characters. These modes don't use square pixels because
in pixels the screen in then 640x400 instead of 640x480. The height of an image
has to be reduced by 1/6 to maintain the right aspect ratio in character mode.
For example you take a 400x300 pixels image to display in 80x50 character mode.
You'll have to resample that image to a width of 80 pixels and the height is
calculated as follows: the factor used is 80/400 is 0.2, which makes the height
300 * 0.2 is 60, but because the pixels aren't square that value has to be
reduced by 1/6, 60 * 5/6 is indeed 50.

=head1 Development History

=over 4

=item 0.02 used arrays instead of strings

=item 0.01 first release based on ascii

=back

=head1 Example: Lesley Garrett / Diva in ASCII

::~~~~;,',_'        ..       .'~//~;,.-.                                    ._,_
~~~~~~;'..:_.                ,=!1xi!+/+_.                                .  .,__
~~~~:::,..~:.              .'/xf$YYS333!_'-.  ..--.                      .   '_:
~~~~~:_:'':,.             .,=|3X88&H&H&f~_,'''__'-.                          .,_
:~~~:::~_,'.          .  -;i1S8H000000HY/;~:_,~:'                            .,:
::~~::::,-.       .-..-.-;xxS&H0000000HSt+;:_,,_-                            ._:
:~~~~~~~,-...     ';,. .:|338&H0H&00B00O1!~:_,,,-                            '_:
:~~~~~::,'''-.    -;'  .=xYXH00HSS000H0Xxi=;:,:~_-                          .___
::~~::::_,'-....  ._-  ./xY8H00H$YH00B03t+++~:=++:.                        .,:::
:~~~::,_:_,'.',-   ..  -~+$XH0H&33&00HS|ttt+=i!t|i_.                     ..'___:
:~~~::_____,,_:,     .-,_;1800H8YfO&XYtit!!+!fSSYf!~'.                 ....'__::
::~~::::::::~::,   .-,:;;/f80B0&S1|ti//i+/+|3X&&8XS1;-                 .-'_:::::
:::::~::::~~~~~_.  -~;=+it38&&&H&Sf|!+ii+!fYX888XY|;-                  .-'___:::
~~:::::::~~~~~~_,. '+!i!x133$$f$33f1f1fff3X88XXS1/-   .-'-.            .-,____::
~~::::~~~~~~::__:. -!1xx1ti=~~::____=1O8XXH&OY|~-     -,_,-.           .''',::::
~~~~~~:~:~~~___,,- .t$$ft/++/~,-.   .+O&&HH83t_                        -',',_::_
~~~~~:~~::::__'-.  .tYSY$$3x/_.      ,1HBB081:                        .-,',,,_::
~~~~~:~~~::::_'.   .tSOY$1+_.       .'iX0W08t-   ..-.        ..       .-',,,,,_:
~~~~~~~~~:____'.   .+YOO$!,. .'-. -'-:x8BW0Xi.  -+1:..-'. -'_,-.      -',,',,''_
~~~~~~~~:_,,,,'-.  ./3X8OY!_-=!_.-+i/f&0BBB8i..,+1Yt~,,..,;=;:'.      .-,_,,,,',
~~~~~~~:,'''''-','..;fX&HH&Sx!ti;=+ixS000BBXi--;fSSf!;__~+|t+;'.     ..-'',,,,,'
~~~~~~:,'',,,-.''--.:xO&H0BB0X3f|t|fSHB00B0X!',=$8&XYfxf$YYf!~'.    .,:::,'-'_,'
~~~~~~_,,__,_'.-'',':tY8H0BBBB0&888&0BB0BB08t,_=fXH&&&888O3x+:-.    .:~~~~_--',,
~~~~~~:::::::,-'__+|/+$XH0BBBBB0BB0BBB00BB081_,:|S&H&HH&8Sft=_-     .:;~~~::,',,
~~~~~~~~~~::_,-'__+8Y!1O&0BBWWWBBWBWBBB00B0&$:'_!Y&H&H0H8Yxi=,.     -~;;;~~~_',,
~~~~~~~~:~~:,__,''+8YffY8HBBBWWBWWBBBBB00WBHY=-'i3&&00H&O$t/:-.     .:;~:~~::,,_
~~~~~~~:~~~:__::__=YYff$O&0BBBWBBBWWBB00BB0HXi..~f&&HHH8Sft=_..     ._;~~~~~:,__
~~~~~~~::~~~:_:~;;iO8Y!xY80BWWWBWWWB&&0BBBB&Xt'.,!XHHH&8Yxi~'.      .,:~;;~~::~_
~~~~~~~~:~~~~::~;;i|ii=tfO&0BWBWWBB&YOBBB0BHSt_',~$8H&XS1!=_-.       '_:~~~:_:::
~~~~~~~~~~~~~~;;;;i!:/1+x$X&0BBBB0&S$X0H0BBH3+,..'tO88S1!=_-.        ._:___,,_::
~~~~~~~~~~~~;;;;=;+f1ti;t1YX&H0HH8XO8B8OXXO$i,   .+33$1i;,-. ..     . ,~~~_,,:~~
~~~~~~~~;;;;;;;;/+/x311xf1f3OX8XSOO&W#B0&3!='    'i1xt+;,..  .       .:~;~__::~~
~~~;~~~~;;;;~;~;|S3X&$/+1fffYSY3x$80BWWWW8|/_....:+++/__'..  .       ';=~~_:~~;;
~~;;;;~;;;;;;=;~i3Y803;!i|$$3SS3t3&0BBWWB0S31/::~;/==~'~_-....       '_=;;:~;~;;
~~;;;;~;;;;;;=;;;i3Xfx|/';f33SXYfX8HBB0BB0&H&$t!==;:,,_/:.. ...     .,'~=;;;;;;;
~;;~~~;;;;;;;;;;~=|Y3f+_',+3YSXOOXSXXOYY3$3Y1+~_,-...';/,.. ....    ._':;=;;;;;;
;;;~~;;;;;;;;;=;;;/xH&i_'.'!YSOX&8X8O1+=++=~,-.....'_;i;'. .,'-'    .',,~==;;;;;
~~~;;;;;;;;;;==;;;=++//,,- ,xYOO88&0BB8YSO3x|!/:::;====_.  .~_.:.   .-_,:;===;;;
~~~;;;;;;;;;==;;;;/fxi1;,'  =1YXXX80BBB&XY1|!+;:~;/==~,.   -=_.~,.  ..'_,~;====;
~~~~;;;;;;;;;=;~;;!XHO3;,'  _13OX8&HBBB0&3|!+////++=~_-   .'=:.~;'.  .-,,:;=====
~~;~~;;;;;;;;;;;;~/xYOt,,,. ,$SYO&H0BBWBHSfxtt||tt!=_-.   .-;~.:/_'. .,,,:;==;=;
;;;;;;;;;;;;;===;~;;=+,':,. 'f&XYO&0BBWWBH888XXOYft;'.     .~~._/~_' .,,,_:;=;=;
~~~~~~~;;;;;;====;;~~:.':,. -1HHXSO&0BWBWWBBB0H&O$i:-.     .:;-:=+!;..':_,_;====
;;;;;;;;;;;;=;==/=;~:_.'::-.,fH00&OO8HBBBWBB0008Y|;,.       ,=-_/!i+' -:~,,~====
;;;;;;;;;;;=========!!'_~~,-;3HBWBHXOX&00B00H&X3|/,.        .;,,t|/=, -_;:,~;===
;;;;;;;;;;========;+fY;_:;:,tO&BWWW08OOX8&&8O$x!=_.          _:,i+~~_..,~~,:;===
;;;;;;;;;;========;!it1~~=;~$XHBW##B0&XS33fxti/~'.           -_:/;:;:..,:;_:;==;
;;;;;;;;;;=========!|i$~~+=!X80W####WB08Yx+=~_'.        ..    ';++//;..-_;_:=/=;
;;;;;;;;;;=======/=+11+_~//$080W##MM#W#B&3t=:,.         ..    .:+/=/='.-_~::=/==
;;;;;;;;========///==;',:=xX0&0W##MM###W0O1!=~,-...     ..     '/+/=;,.'_~::;===

=cut

use strict;
use Diagnostics;
use Getopt::Long;
use File::Copy;
use Win32;

#Gray Scale picture ASCII art Generator
#(c)1999 by Roland van Ipenburg

# info
my %INFO = (
	author	=> 'Roland van Ipenburg',
	email	=> 'ipenburg@xs4all.nl',
	name	=> 'gspaag',
	desc	=> 'Gray Scale picture ASCII art generator',
	version	=> '0.02',
);

# version information line
my $VERSION_STRING = <<EOF_VERSION;

$INFO{'name'} - $INFO{'desc'} v$INFO{'version'} by $INFO{'author'} - $INFO{'email'}
EOF_VERSION

# help information lines
my $HELP_STRING = <<EOF_HELP;

Usage: $^X $0 [OPTION...] [FILE] [FILE]...
\u$INFO{'desc'}

  -b --backup=EXT     backup when nessecary with extension EXT (default .bak)
  -c --contrast       optimize contrast (default off)
  -i --input=FILE     read input from FILE (default STDIN)
  -f --font=N         optimize for font number N (default 0)
  -l --log=FILE       write log in FILE (default off)
  -n --negative       output is light on dark medium (default dark on light)
  -o --output=FILE    write output to FILE (default STDOUT)
  -p --pal=STRING     use STRING as ASCII palette (default font number 0)
  -r --replace        do not make backups (default off)
  -s --stream         do not insert newlines (default off)
  -v --verbose=LEVEL  display LEVEL messages while running (default off)

     --help           display this help and exit
     --version        output version information and exit

Backup is persistent.
Input can be multiple, wildcarded or (multiple) directory. Multiple input
sets output to input unless output is stout.
EOF_HELP

my @font = ();

# ASCII charlist
# every possible value has one char to it or a close one (hence doubles)
# darkest to lightest

# My systems 8x16 font:
$font[0] = 'M#WB0H&8XOSY3$f1x|t!i+/=;~:_,\'-..   ';

# My systems 8x8 font:
$font[1] = 'MN#HH@WQ89VSY$&C7+=?/;:_!-.\'`  ';

# The next three are from BMP2ASC as found in ASCIIEditor
# (http://studenten.freepage.de/meph/ascii/ascii.htm)
# BMP2ASC:
$font[2] = '##################@WM%XKZFEQ8RO0GB96PAYDUNH54VS32TL7CJI$wmgyqpkdhbxszuoaenv&rtlj1fci][+=/?)(><|}{!*";:^-~_\',`.  ';

# BMP2ASC-indexed:
$font[3] = '#######################WWWWWWMMMMMMMRRRRRRXXXXXXXVVVVVVYYYYYYIIIIIIIttttttiiiiiii++++++======;;;;;;;......       ';

# BMP2ASC-indexed2:
$font[4] = '#######################MMMMMMMMMMMMMMXXXXXXXXXXXXX+++++++++++=============;;;;;;;;;;;;;.............             ';

# From Scarecrows FAQ:
# (http://)
$font[5] = '$@B%8&WM#*oahkbdpqwmZO0QLCJUYXzcvunxrjft/\\|()1{}[]?-_+~<>i!lI;:,"`\'. ';

my $bin_mode = 1;
my @files = ();
my $file = "";
my $file_container = "";
my $backup_name = "";

# defaults
my %optctl = (
	'backup'	=> ".bak",
	'contrast'	=> 0,
	'input'		=> "-",
	'font'		=> 0,
	'log'		=> "",
	'negative'	=> 0,
	'output'	=> "-",
	'pal'		=> "",
	'replace'	=> 0,
	'stream'	=> 0,
	'verbose'	=> 0,
	'help'		=> 0,
	'version'	=> 0,
);

&GetOptions (\%optctl,
	'backup|b=s',
	'contrast|c!',
	'input|i=s',
	'font|f=i',
	'log|l=s',
	'negative|n!',
	'output|o=s',
	'pal|p=s',
	'replace|r!',
	'stream|s!',
	'verbose|v=i',
	'help|h!',
	'version!',
);

# file locking stuff:
my $lock_ex = 2;
my $lock_un = 8;

# Print messages or not:
sub verbose {
	@_	? ((shift) <= $optctl{'verbose'} )
		: 1;
}

# Handle expanded input:
sub handle_arguments {
	print "Handling input argument... " if verbose(1);
	if ($optctl{'input'} ne '-' ) {
		push(@ARGV, $optctl{'input'});
		for (@ARGV ) {
			SWITCH: {
				# Handle single file:
				if (-f $_ ) {
					push(@files, $_);
					last SWITCH;
				}
				# Handle single directory as input:
				if (-d $_ ) {
					push(@files, glob($_.'/*.*') );
					last SWITCH;
				}
				push(@files, glob($_) );
			}
		}
		# Remove non-unique file entries:
		my %saw;
		undef %saw;
		@files = grep(!$saw{$_}++, @files);
	}
	print "Done.\n" if verbose(1);
	print "Warning: cannot use file locking under Windows95!\n"
		if (verbose(1) && Win32::IsWin95 );
		
	return 1;
}

#
# LOG FUNCTIONS
#

sub start_log {
	if ($optctl{'log'} ne "" ) {
		open (LOG, ">>$optctl{'log'}") || die "can't open $optctl{'log'}, stopped $!";
		flock(LOG, $lock_ex) unless Win32::IsWin95;
		print LOG scalar(localtime)." $INFO{'name'} $optctl{'input'} $optctl{'output'} ";
		flock(LOG, $lock_un) unless Win32::IsWin95;
		close (LOG) || die "can't close LOG, stopped $!";
	}
	return 1;
}

sub end_log {
	if ($optctl{'log'} ne "" ) {
		open (LOG, ">>$optctl{'log'}") || die "can't open $optctl{'log'}, stopped $!";
		flock(LOG, $lock_ex) unless Win32::IsWin95;
		print LOG "OK\n";
		flock(LOG, $lock_un) unless Win32::IsWin95;
		close (LOG) || die "can't close LOG, stopped $!";
		print "Logged in $optctl{'log'}.\n" if verbose(1);
	}
	return 1;
}

#
# INPUT FUNCTIONS
#

sub read_input {
	print "Opening $optctl{'input'} for input... " if verbose(1);
	open (INPUT, "<$optctl{'input'}") || die "can't open $optctl{'input'}, stopped $!";
	flock(INPUT, $lock_ex) unless Win32::IsWin95;
	print "Done.\nReading $optctl{'input'}... " if verbose(1);

	# slurp file
	$file_container = "";
	binmode INPUT if $bin_mode;
	{
		local $/ = undef;
		$file_container = <INPUT>;
	}

	flock(INPUT, $lock_un) unless Win32::IsWin95;
	print "Done.\nClosing $optctl{'input'}... " if verbose(1);
	close (INPUT) || die "can't close INPUT, stopped $!";
	return 1;
}

#
# BACKUP FUNCTION
#

sub handle_backup {
	if (($optctl{'replace'} == 0) && (-e $optctl{'output'}) ) {
		print "Done.\nBacking up $optctl{'output'} " if verbose(1);
		$backup_name = $optctl{'output'};
		while (-e $backup_name ) {
			$backup_name .= $optctl{'backup'};
		}
		print "to $backup_name... " if verbose(1);
		File::Copy::syscopy("$optctl{'output'}", "$backup_name") || die "can't copy $optctl{'output'} to $optctl{'output'}$optctl{'backup'}, stopped $!";
	}
	return 1;
}

#
# OUTPUT FUNCTIONS
#

sub open_output {
	print "Done.\nOpening $optctl{'output'} for output... " if verbose(1);
	open (OUTPUT, ">$optctl{'output'}") || die "can't open $optctl{'output'}, stopped $!";
	flock(OUTPUT, $lock_ex) unless Win32::IsWin95;
	print "Done.\nInitiating process... " if verbose(1);
	print "Done.\nProcessing:\n" if verbose(1);
}

sub close_output {
	print OUTPUT;
	flock(OUTPUT, $lock_un) unless Win32::IsWin95;
	print "Done.\nClosing $optctl{'output'}... " if verbose(1);
	close (OUTPUT) || die "can't close OUTPUT, stopped $!";
	print "Done.\n" if verbose(1);
	return 1;
}

sub process_file {
	$optctl{'input'} = shift;
	# set input to output if input is expanded and output not stdout:
	if (($#files > 0) && ($optctl{'output'} ne "-") ) {
		$optctl{'output'} = $optctl{'input'};
	}
	
	start_log;
	read_input;
	handle_backup;
	open_output;
	
	$_ = $file_container;

	if ($optctl{'pal'} ) {
		$font[$optctl{'font'}] = $optctl{'pal'};
		print "Using user defined font ($font[$optctl{'font'}])\n" if verbose(1);
	}
	else {
		print "Using font $optctl{'font'} ($font[$optctl{'font'}])\n" if verbose(1);
	}

	# Reverse when light on dark:
	if ($optctl{'negative'} ) {
		 $font[$optctl{'font'}] = reverse($font[$optctl{'font'}]);
	}
	my @pal = split //, $font[$optctl{'font'}];

	my $tga_header = "";
	my @tga_true = ();
	my @tga_gray = ();
	my $tga_ascii = "";
	my $tga_width = 0;
	my $tga_height = 0;
	my $tga_pixels = 0;
	my $gray = "";
	my $gray_min = 255;
	my $gray_max = 0;
	my $progress = 8;
	my $i = 0;

	# Split header and image:
	$tga_header = substr($_,0,18);

	# Check for Uncompressed True-color image:
	if (ord(substr($tga_header, 2, 1)) != 2 ) {
		die "Error: $optctl{'input'} isn't an Uncompressed True-color TGA file! Stopped";
	}

	# Get dimensions:
	($tga_width, $tga_height) = unpack("SS", substr($tga_header, 12, 4) );
	$tga_pixels = $tga_width * $tga_height;

	@tga_true = unpack("C" x ($tga_pixels * 3), substr($_,18) );

	# Make image grayscale:
	print "(Progress indication 1:$progress)\n" if verbose(2);
	print "Converting to grayscale... " if verbose(1);
	print "\n" if verbose(2);
	while ($i < $#tga_true) {
		# Calculate gray from red, green and blue components:
		$gray =	int(
			(($tga_true[$i++] + $tga_true[$i++] + $tga_true[$i++]) / 3 ) + .5
		);
		if ($optctl{'contrast'} ) {
			if ($gray_min > $gray ) {
				$gray_min = $gray;
			}
			if ($gray_max < $gray ) {
				$gray_max = $gray;
			}
		}
		push @tga_gray, $gray;
		print "*" if (verbose(2) && ($i % ($progress * 3) == 0) );
	}

	# Since most TGAs are ordered bottom to top and left to right the image has to
	# be flipped to get the top to bottom left to right ordering of ltr text.
	# Flip image to make ordering top to bottom instead of bottom to top:

	$i = 0;
	my @flip = ();
	my @line = ();
	my $offset = undef;

	while ($i < $tga_height ) {
		$offset = $i * $tga_width;
		@line = @tga_gray[$offset..($offset + $tga_width - 1)];
		unshift @flip, @line;
		$i++;
	}

	@tga_gray = @flip; 

	if (!($optctl{'contrast'}) || ($gray_min == $gray_max) ) {
		$gray_min = 0;
		$gray_max = 255;
	}
	else {
		$gray_min = $gray_min;
		$gray_max = $gray_max;
	}

	print "\n" if verbose(2);
	print "Done." if verbose(1);

	$i = 0;

	# Make image ascii:
	print "\nConverting to characters... " if verbose(1);
	print "\n" if verbose(3);
	while ($i < $tga_pixels ) {
		$gray = $pal[
			int((($tga_gray[$i] - $gray_min) * $#pal) / ($gray_max - $gray_min))
		];
		
		$tga_ascii .= $gray;
		print $gray if verbose(3);
		if (($i % $tga_width == ($tga_width - 1)) && !($optctl{'stream'}) ) {
			$tga_ascii .= "\n";
			print "\n" if verbose(3);
		}
		$i++;
	}

	# Remove pending spaces:
	if (!($optctl{'stream'}) ) {
		print "Done.\nRemoving pending spaces... " if verbose(1);
		$tga_ascii =~ s#\s+\n#\n#gis;
	}

	$_ = $tga_ascii;

	close_output;
	end_log;

}

print $HELP_STRING if $optctl{'help'};
print $VERSION_STRING if $optctl{'version'};

# Avoid mixing verbose messages with output:
$optctl{'verbose'} = 0 if ($optctl{'output'} eq "-" );

# Skip program if help or version was requested:
if (($optctl{'help'} + $optctl{'version'}) == 0 ) {
	handle_arguments;
	foreach $file(@files) {
		process_file($file);
	}
	print "Finished.\n" if verbose(1);
}