#!/usr/bin/perl -w

# $Id: text2X,v 1.19 2003/05/05 00:36:15 tomj Exp $

# This filter converts text into vector motion
# commands for the WPS X record type, for the
# Model 423.
#
# Row/column position is problematic in Story Teller
# use; each t2a record produces one X-text record,
# hence one call per line of text, so we can't
# keep track of cursor (sic) position within this
# code; it's up to the programmer (ahem) to "home"
# the cursor at the right time and place.
#
# This generates voluminous output, which can be
# run-length encoded with squish-flu.
#
# There are no implicit newlines; they must be explicitly
# defined with \r \n etc.


# All internal motion is done with generic "N NE E SE ..."
# commands, which get translated to real commands on output.
# It's easier to remember what "SE" does than "3".

$NUL= "\00";
$SOH= "\01";
$STX= "\02";
$ETX= "\03";
$EOT= "\04";


# Model 423 output resolution and scale is approx. 100 dpi,
# 700 high (Y) x 1000 wide (X).

my $MAX_Y= 700;
my $MAX_X= 1000;

# These are the dimensions of the box that the font
# characters are drawn in. Can't be changed without
# changing all the font data.

my $CHEIGHT= 8;
my $CWIDTH= 6;

# This scales characters to the desired physical
# size.

my $SCALE= 8;			# *initial* scale,
my $CSPACE= 2;			# inter-char spacing
my $LSPACE= 3;			# inter-line spacing

my $CELL_HEIGHT;		# max. height of characters
my $CELL_WIDTH;
my $CHAR_SPACE;			# character horiz. spacing
my $LINE_SPACE;			# character vert spacing


# Special characters.

my $FF= 12;		# text "home",
my $CR= 13;
my $LF= 10;

# This hash converts N NE E SE ... meta-commands
# into actual ones supported by the Model 423.

%CMDS= (
	'E'  => "0",
	'NE' => "1",
	'N'  => "2",
	'NW' => "3",
	'W'  => "4",
	'SW' => "5",
	'S'  => "6",
	'SE' => "7",
	'U'  => "8",
	'D'  => "9",
	'H'  => ":",		# home
	'R'  => "<",		# repeat
);


# Font definitions for the Model 423, via t2a.

# The data is simply polar motion commands and pen up/down.
# Upper case and digits are fixed-width; everything else
# is proportional, determined by maximum East excursion
# while drawing.
#
# The origin for each character is the lowe left corner.
# The pen starts in the down position, and is lifted
# when done.

# Case is insignificant, space ignored.
# Note that all commands must begin with a digit.
# Even pen.


%FONT= (
	'!' => "1d 1n 1u 2n 1d 5n",
	'"' => "6n 1d 2n 1u 2e 1d 2s",
	'#' => "2e 1d 8n 1u 2e 1d 8s 1u 2ne 1n 1d 6w 1u 2n 1d 6e",
	'$' => "1d 6e 4n 6w 4n 6e 1u 2w 1nw 1d 10s",
	'%' => "1d 1n 6ne 1n 1u 4w 1d 2w 2s 2e 2n 1u 4se 2s 1d 2s 2w 2n 2e",
	'&' => "1ne 1d 4ne 1n 1nw 2w 2sw 5se 1u 2n 1d 2sw 3w 1n",
	"'" => "5n 1d 3n",
	'(' => "5n 3ne 1d 1w 2sw 4s 2se 1e",
	')' => "7n 1ne 1d 1e 2se 4s 2sw 1w",
	'*' => "1n 1d 6ne 1u 3s 1d 6w 1u 3n 1d 6se",
	'+' => "2e 1ne 1d 6n 1u 3sw 1d 6e",
	',' => "2ne 1n 1d 2s 3sw 1u 1e",
	'-' => "4n 1d 6e",
	'.' => "1d 1n 1e 1s 1w 1u 1e",
	'/' => "1d 1n 6ne 1n",
	0 => "1d 8n 6e 8s 6w 6ne",
	1 => "6n 1d 2ne 8s",
	2 => "7n 1d 1n 5e 1se 1s 6sw 6e",
	3 => "8n 1d 6e 8s 6w 1u 3ne 2n 1d 3e",
	4 => "6e 1d 5n 6w 3n 1u 6e 1d 3s",
	5 => "1d 6e 5n 6w 3n 6e",
	6 => "5n 1d 6e 5s 6w 8n 6e",
	7 => "3e 1d 4n 3ne 1n 6w",
	8 => "1d 8n 6e 8s 6w 1u 5n 1d 6e",
	9 => "1d 6e 8n 6w 3s 6e",
	':' => "5n 1d 2s 2u 2s 1u 1e",
	';' => "6n 1d 2s 2u 2s 3sw 1u 1e",
	'<' => "5e 1ne 1d 3nw 3ne",
	'=' => "3n 1d 6e 1u 2n 1d 6w",
	'>' => "1d 1n 1d 3ne 3nw",
	'?' => "3e 1d 1n 1u 2n 1d 1n 3ne 1n 6w 1s",

	'@' => "1d 8n 6e 6s 4w 3n 3e 3s 1u 2s 1d 5w",
	A => "1d 8n 6e 8s 1u 5nw 1w 1d 6e",
	B => "1d 8n 6e 8s 6w 1u 5n 1d 6e",
	C => "1d 8n 6e 1u 2s 6sw 1d 6e",
	D => "1d 8n 2e 3se 2s 3sw 2w",
	E => "1d 8n 6e 1u 3s 1d 6w 1u 5s 1d 6e",
	F => "1d 8n 6e 1u 3s 1d 6w",
	G => "1d 8n 6e 1u 3s 1d 5s 6w 1u 3ne 2n 1d 3e",
	H => "1d 8n 1u 6e 1d 8s 1u 5nw 1w 1d 6e",
	I => "3e 1d 8n",
	J => "2n 1d 2s 5e 8n",
	K => "1d 8n 1u 6e 1d 4sw 2w 2e 4se",
	L => "8n 1d 8s 6e",
	M => "1d 8n 3se 3ne 8s",
	N => "1d 8n 1u 2s 1d 6se 8n",
	O => "1d 8n 6e 8s 6w",
	P => "1d 8n 6e 3s 6w",
	Q => "1d 8n 6e 8s 6w 1u 1sw 1d 3ne",	# descender
	R => "1d 8n 6e 3s 6w 2e 4se 1s",
	S => "1d 6e 4n 6w 4n 6e",
	T => "3e 1d 8n 1u 3w 1d 6e",
	U => "1d 8n 1u 6e 1d 8s 6w",
	V => "3n 1d 5n 1u 6e 1d 5s 3sw 3nw",
	W => "8n 1d 8s 3e 8n 1u 3e 1d 6s 2sw 2w",
	X => "1d 2n 6ne 1u 6w 1d 6se 2s",
	Y => "3e 1d 4n 3nw 1u 5e 1d 1s 3sw",
	Z => "8n 1d 6e 1s 6sw 1s 6e",
	'[' => "3e 1d 3w 8n 3e",
	"\\" => "8n 1d 1s 6se 1s",
	']' => "1d 3e 8n 3w",
	'^' => "3e 1d 8n 3sw 1u 6e 1d 3nw",
	'_' => "1s 1d 6e",

	'`' => "4n 1d 4sw",
	a => "1n 1d 2n 1ne 3e 1n 6s 2n 1sw 2w 1nw",
	b => "6n 1d 6s 4e 4n 4w",
	c => "1d 4n 4e 1u 4s 1d 4w",
	d => "4ne 1d 4w 4s 4e 6n",
	e => "2n 1d 4e 2n 4w 4s 4e",
	f => "1d 5n 1ne 2e 1u 1s 1sw 1d 2w",
	g => "2s 1d 4e 6n 4w 4s 4e",		# descender
	h => "1d 7n 1u 3s 1d 4e 4s",
	i => "6n 1d 1s 1u 1s 1d 4s",
	j => "3n 3ne 1d 1s 1u 1s 1d 4s 2sw 2w",
	k => "6n 1d 6s 6ne 1u 3sw 1d 3se",
	l => "2e 1d 1w 6n",
	m => "1d 5n 1s 2e 3s 1u 3n 1d 2e 4s",
	n => "1d 5n 1s 4e 4s",
	o => "1d 4n 4e 4s 4w",
	p => "4s 1d 8n 4e 4s 4w",
	q => "4e 1d 4w 4n 4e 6s 2ne",
	r => "1d 5n 1s 4e 1s",
	s => "1d 4e 2n 4w 2n 4e",
	t => "2e 1d 6n 1u 2sw 1d 4e",
	u => "4n 1d 4s 4e 1s 5n",
	v => "4n 1d 1s 2se 1s 1n 2ne 1n",
	w => "4n 1d 4s 4e 4n 1u 2w 1d 4s",
	x => "4n 1d 4se 1u 4w 1d 4ne",
	y => "4n 1d 4s 4e 1u 4n 1d 6s 4w",
	z => "4n 1d 4e 4sw 4e",
	'{' => "2e 1d 1nw 2n 1nw 1ne 2n 1ne",
	'|' => "2e 1d 8n",
	'}' => "1d 1ne 2n 1ne 1nw 2n 1nw",
	'~' => "4n 1d 1ne 2se 1ne",

);

# We have no way to tell the absolute position of the
# pen; we can only draw from the current position. Only
# FF will set a known position (home) from which we can
# move; the programmer/author must keep track of
# pen position!

my $Y= 0;		# current plotter position,
my $X= 0;

my $tY= 0;		# target pen position,
my $tX= 0;

my $pen= "FOO";		# pen position; we track it to avoid needless up/down
my $count= 0;		# total commands output

my $f= "-";		# input file else - (stdin)
my @I;			# input buffer
my $lastc= "";

	use Getopt::Std;
	use vars qw /$opt_d $opt_h $opt_l $opt_p $opt_q $opt_t $opt_x/;
	getopts ('hdls:tpqx');
	print STDERR "text2X: -h for usage\n" unless $opt_q;
	&usage() if $opt_h;

	$f= $ARGV[0] if scalar @ARGV;

	print $NUL, $NUL, $NUL, $SOH, "X", $STX if $opt_x;

	$|= 1;

# We have no way to tell where the pen is; assume we're at the
# home position.

	&scale ($SCALE);			# set stroke length multiplier
	&directive ("/SCALE $opt_s")  if defined $opt_s;

	&home();				# move to text home,
	$X= $tX; $Y= $tY;			# assume we're there.

	if ($opt_t) {
		&go ("H");			# home plotter,
		@I= sort keys %FONT;		# test data,
		push @I, "\n";

# @ARRAY= (<>) is generally deemed bad practice, but our input
# data is tiny, and it makes -t easy.

	} else {
		open (F, $f) or die "Can't open file \"$f\"\n";
		@I= <F>;			# slurp up stdin,
		close F;
	}

	foreach (@I) {				# for all lines...
		chomp;
		print STDERR "text2X: input /", quotemeta $_, "/\n" if $opt_d;
		next if &directive($_);		# process directives,

		@L= split (//, $_);
		while (scalar @L) {		# all chars in a line,
			$_= shift @L;
			if ($_ eq "\\") {
				my $k= shift @L;
				if (not defined $k) {	# somewhat obscurely,
					&dochar ("\\"); # \  at end of line,
					next;
				}
				&dochar ($k) if $k eq "\\";
				&dochar ("\r") if $k eq "r";
				&dochar ("\n") if $k eq "n";
				&dochar ("\f") if $k eq "f";
				&dochar ("\b") if $k eq "b";

			} else {
				&dochar ($_);
			}
		}
	}

# It's certain that we have deferred motion; either after
# drawing a character (to move to the origin of the next
# character cell) or if the input is nothing but motion commands
# (CR, LF, FF, etc). Flush them.

	&moveto;


	print $ETX . $EOT . $NUL if $opt_x;
	if (not $opt_q) {
		print "\n-----------------------------\n" if $opt_p;
		print STDERR "text2X: $count commands generated.\n";
	}
	exit 0;



# See if this line is a plotter directive; return true if so.

sub directive {
$_= shift;		# input line

my ($v1, $v2, $v3);

	($v1, $v2, $v3)= $_ =~ /^.(\w+)\s*(\d*)[,\s]*(\d*)/;
	return 0 if not defined $v1; 			# not a directive 

	if ($v1 eq "POS") {
		$tX= $X= $v2; $tY= $Y= $v3;
		print STDERR "text2X: POS= ($X, $Y)\n" if $opt_d;
		return 1;

	} elsif ($v1 eq "SCALE") {
		print STDERR "text2X: SCALE\n" if $opt_d;
		if ($v2 < 1 or $v2 > 24) {
			print STDERR "text2X: SCALE /$v2/ OUT OF RANGE!\n";

		} else {
			&scale ($v2);
		}
		return 1;

	} elsif ($v1 eq "HOME") {
		&home();
		&go ("H");
		print STDERR "text2X: HOME\n" if $opt_d;
		return 1;

	} elsif ($v1 eq "LINE") {
		$tX= $X= $v2 * ($CELL_HEIGHT + $LINE_SPACE);
		$tY= $Y= 0;
		print STDERR "text2X: LINE $v2 (Y= 0)\n" if $opt_d;
		return 1;
	}
	return 0;					# isn't one.

}

# Set the print scale.

sub scale {
my $scale= shift;

	$SCALE= $scale;			# char stroke len multiplier

	$CELL_HEIGHT= $CHEIGHT * $SCALE;# max. height of characters
	$CELL_WIDTH= $CWIDTH * $SCALE;
	$CHAR_SPACE= $CSPACE * $SCALE;	# character horiz. spacing
	$LINE_SPACE= $LSPACE * $SCALE;	# character vert spacing
}


# Process a single character. We defer motion to the next
# character position until we get the next character, because
# the damned thing is so slow.

sub dochar {
my $c= shift;

my $width;		# width of printed character,

	if ($c eq "\n") {
		print STDERR "text2X: LF\n" if $opt_d;
		my $foo= $tY;			# for -p code,
		$tY -= ($CELL_HEIGHT + $LINE_SPACE);
		$tY= ($MAX_Y - $CELL_HEIGHT) if $tY < 0;
		print $tY > $foo ? "-----------------------\n" : "\cJ" 
		    if $opt_p;			# ---'s at wrap to top

	} elsif ($c eq "\r") {
		print STDERR "text2X: CR\n" if $opt_d;
		print "\r" if $opt_p;
		$tX= 0;

	} elsif ($c eq "\cK") {			# reverse LF
		print STDERR "text2X: VT\n" if $opt_d;
		$tY += ($CELL_HEIGHT + $LINE_SPACE);

	} elsif ($c eq "\f") {			# FF, form feed,
		print STDERR "text2X: FF\n" if $opt_d;
		print "-----------------------\n" if $opt_p;
		&go ("H");			# issue home,
		&home();

	} elsif ($c eq "\b") {
		$tX -= $width;			# width of last char,
		$tX= 0 if $tX < 0;

	} elsif ($c eq " ") {
		print " " if $opt_p;
		$tX += $CELL_WIDTH;		#

# Printable character; if there is not enough room for
# the character, move to the beginning of the next line,
# else print the character and set the next character 
# position.

	} else {
		print STDERR "text2X: dochar ($c)\n" if $opt_d;
		if ($tX + $CELL_WIDTH >= $MAX_X) { # if not enough room,
			&dochar ("\r");		# move to start of next
			&dochar ("\n");		# line, first.
		}
		print $c if $opt_p;
		$width= &draw ($c);		# draw the character,
		$tX += $width + $CHAR_SPACE;	# start of next char,
	}
	$lastc= $c;
}

# Move to text home position, which is upper left. Genuine
# plotter home is lower left.

sub home {

	$tY= $MAX_Y - $CELL_HEIGHT;		# where we want to go,
	$tX= 0;
	$X= $Y= 0;				# where we are.
	print STDERR "text2X: HOME\n" if $opt_d;
}


# Move the pen to the target coordinates. Since the system
# is so damned slow, we work hard to use the shortest path.
# The generated motion commands are buffered, and will get a
# run-length compression pass later.

sub moveto {

print STDERR "text2X: X: At $X, target $tX, distance= ", $tX - $X, "\n" if $opt_d;
print STDERR "text2X: Y: At $Y, target $tY, distance= ", $tY - $Y, "\n" if $opt_d;

	# X= row (E, W)
	# Y= col (N, S)
	while ($tX != $X or $tY != $Y) {
		&go ("N")  if $tY >  $Y and $tX == $X;
		&go ("NE") if $tY >  $Y and $tX >  $X;
		&go ("E")  if $tY == $Y and $tX >  $X;
		&go ("SE") if $tY <  $Y and $tX >  $X;
		&go ("S")  if $tY <  $Y and $tX == $X;
		&go ("SW") if $tY <  $Y and $tX <  $X;
		&go ("W")  if $tY == $Y and $tX <  $X;
		&go ("NW") if $tY >  $Y and $tX <  $X;
	}
}


# Draw the character, and return it's drawn width.  The pen is
# up, and at the end of the previous character's final stroke.
# Characters are drawn along the target Y ($tY) baseline; the
# simplest thing to do now is to move the pen back down to the
# baseline, but that often involves a lot of wasted motion (eg.
# drawing "F" followed by "-", the pen would move down to the
# baseline, then back up to begin the "-" stroke). Instead, we
# readahead the strokes from the font for the new char, and adjust
# the target XY position accordingly, until we come across a pen down
# command, at which time we really have to move to put pen to paper.
# 
# This optimization saves a lot of motion and paper tape length.

sub draw {
my $c= shift;

my $startY;		# initial Y position 
my $startX;		# initial X position 
my $maxX;		# furthest X excursion,
my $move= 0;		# for motion command lookahead

	if (not defined $FONT {$c}) {
		print STDERR "text2X: No font data for character /$c/\n";
		return $CELL_WIDTH;		# assume maximum
	}
	$startY= $tY;				# remember starting positoin
	$startX= $X;
	$maxX= 0;

	print STDERR "\ntext2X: Printing character $c\n" if $opt_d;

	foreach (split (/\s+/, $FONT{$c})) {	# execute all the commands
		$_= uc $_;
		my ($rpt, $cmd)= /(\d*)(.*)/;	# break into repeat and command,
		$rpt= 1 if not $rpt;		# in case "N" instead of "1N"
		$rpt *= $SCALE;			# scale the character,

# The pen is currently where the last drawn character left it. Rather
# than physically move to the next char's origin before beginning
# the first drawn stroke, we adjust the new character's origin such
# that we move in as direct a line as possible to where the pen goes
# to paper.

		if (not $move) {		# if we're looking ahead,
			$tY += $rpt if $cmd =~ /N/;	# track motion,
			$tY -= $rpt if $cmd =~ /S/;
			$tX += $rpt if $cmd =~ /E/;
			$tX -= $rpt if $cmd =~ /W/;
			if ($cmd eq "D") {	# finally, pen down,
				&moveto();	# move to adjusted origin,
				&go ($cmd);	# put pen down,
				$move= 1;	# subsequent commands execute.
			}
			next;
		}
		&go ("$rpt$cmd", $move);	# for this char,
		$maxX= $X if $X > $maxX;	# remember largest X excursion,
	}
	&go ("U");				# always raise the pen,
	$tY= $startY;				# restore char baseline
	$tX= $startX;				# and origin,
	print STDERR "text2X:   width ", $maxX - $startX, "\n" if $opt_d;
	return $maxX - $startX;			# char's wides point
}

# "Execute" the command (motion or pen up/down, etc). This 
# also translates the generic command to Model 423 commands.
# It handles leading repeat counts, whitespace, case, etc.
# We also avoid needless pen motion by remembering the last-
# issued command.

sub go {
my $cmd= shift;
my $mo= shift;		# true if motion executes

my ($r, $c);	# repeat, command

	$mo= 1 if not defined $mo;		# true if not specified,

	$r= 1; $c= $cmd;			# assume no repeat,
	($r, $c)= $cmd =~ /(\d+)(.*)/ if $cmd =~ /^\d/;

	$c= uc $c;				# simpler,
	if ($c =~ /H/) {			# home means
		print $CMDS {$c};		# output command,
		$X= $Y= 0;			# we're in lower left corner,
		return;

	} elsif ($c =~ /U|D/) {			# 
		if ($pen ne $c) {		# if different pen position,
			&outcmd ($c) if $mo;	# output pen command,
			$pen= $c;		# remember it,
		}
		return;
	}

	while ($r--) {				# handle repeat

# Note this works for "NE" and "N" then "E"... and also 
# non-motion commands, "U" etc.

		++$Y if $c =~ /N/;		# track motion,
		--$Y if $c =~ /S/;
		++$X if $c =~ /E/;
		--$X if $c =~ /W/;

		&outcmd ($c) if $mo;
	}
}

# Output the logical command.

sub outcmd {
my $c= shift;

	return if $opt_p;
	if ($opt_l) {
		print $c;

	} else {
		print STDERR "text2X: /$c/ not in command table!\n" 
		    if not exists $CMDS {$c};

		print $CMDS {$c} if exists $CMDS {$c};
	}
	++$count;
}





sub usage {

print STDERR << "USAGE";

text2X converts a simplistic ASCII input stream into a simple
(but bulky) N/S/E/W pen up/down command stream, specifically for
"Flutterwumper" PI interpreters. It handles wrapping at edges,
efficient motion, full 128ASCII.  Upper case and digits are fixed
width; all others are proportionally spaced. It is hard coded
for 700h x 1000w.

     -s N    Set output scale to N (1..24)
     -d      Debug output.
     -t      Test: self-generate all defined characters.
     -l      ("L") Output logical not physical commands.
     -p      Proof; output input characters formatted approximately
             as the output would appear, with --------'s to
             indicate end of sheet.
     -q      Quiet, no chatter (as filter).
     -x      Wrap the data in WPS record overhead.
     -h      This usage.
USAGE

	exit;

}