#!/usr/bin/perl -w

# Use:
#  If invoked as pcl2ps:
#       pcl2ps [ file ]
#  prints out PostScript translation (done with mpage or similar).
#  If invoked as pcl2txt:
#       pcl2txt [ file ]
#  prints out some settings, and then the text (kind of debug mode).
#  If invoked as hpgl2txt:
#       hpgl2txt [ file ]
#  prints out settings (kind of debug mode).
#  No use for hpgl2ps version.
# Save this script under any name (e.g. pcl2ps) and create symlinks to it
# with those other names.
#
# Unsuitable for anything but the simplest text files:
# we ignore most PCL commands (including graphics and fancy fonts),
# extract any plain-text and print it (using the one page layout).
# Do not (yet) know about PCL6 (a.k.a PCL XL).
#
# Would need a yacc parser. Known problems:
#   Record anything between 'start' and 'stop' macro definition and replay
#     as needed. (Not a problem if all macros defined are used.)
#   Keep HP-GL label terminator DT character and use for LB labels.
# At least, we show PCL commands in the order that they occur.
#
#V2.4   8 Jul 02  Recognize some PJL
# 2.3   3 Jul 02  Efficiency to the detriment of cosmetics
# 2.2   1 Jul 02  Cosmetics
# 2.1  28 Jun 02  Added RS232 and more HP-GL commands from HP7475A manual
# 2.0  27 Jun 02  Added HP-GL commands and usage as hpgl2txt
# 1.7  26 Jun 02  Added pict frame anchor, fixed decimal pict frame sizes
# 1.6  11 Jun 02  Added more PCL commands, fixed paper type
# 1.5  15 Feb 02  Added more PCL commands
# 1.4  20 Nov 01  Fixed signed decipoints
# 1.3  13 Apr 00  Added more PCL commands
# 1.2  11 May 99  Recognize most (all?) PCL commands
# 1.1   5 May 99  Added a2ps options
# 1.0   4 May 99  Written by Paul Szabo <psz@maths.usyd.edu.au>
#                   (with help from Jim Richardson)

$txt = ( $0 =~ m/2txt/ );
$hpg = ( $0 =~ m/hpgl2/ );

$head='';
$tail = join('', <>);	# Read whole input

# Default values
$ori = 0;	# Orientation (portrait, not landscape)
$len = 60;	# Page length
$cpi = 10;	# Characters per inch

setuppjl();
setuphpg();
setuppcl();

dopjl();
if ($hpg) {
  while (1) {
    dohpg(); dopcl() or last;
    # More efficient than simple
    # dohpg() or dopcl() or last;
  }
}
else {
  while ($tail =~ m/\e/) {
    $head.=$`;
    $tail="\e$'";
    dopcl() or last;
  }
}

$head .= $tail;
$head =~ s/\x01\r\n?/\n/g;	# Fix weird line termination: SOH CR NL
$head =~ s/\r\n?/\n/g;		# Fix not-so-weird termination: CR NL

while ($head =~ s/([^\t\n\f -~])/sprintf "<X%2.2x>", ord $1/e) {
  if ($txt) { printf(" Odd character:    <X%2.2x>\n", ord $1); }
}

1 while $head =~ s/^(.{80})\f(.{80})/$1\n\f$2/mg;	# Long pages
1 while $head =~ s/^(.{80})(.{80})/$1\n$2/mg;		# Long lines


if ($ori == 1) { $wid = int(11 * $cpi); }
else           { $wid = int( 8 * $cpi); }
# The following options are for the old mpage 2 (Jun89) at maths:
$cmd = 'mpage -s -P -1 -b';
if ($ori == 1) { $cmd .= " -l -L$len -W$wid";}
else           { $cmd .= " -n -L$len -W$wid";}
## The newer mpage 2.5 (Nov97) at oberon.ucc needs the following instead:
#$cmd = 'mpage -P- -1 -bA4 -o';
#if ($ori == 1) { $cmd .= " -l -L$len -W$wid";}
#else           { $cmd .= "    -L$len -W$wid";}
## Or we could use a2ps 4.10.1:
#$cmd = 'a2ps -1 -B -q -o-';
#if ($ori == 1) { $cmd .= " -r -L$len -l$wid";}
#else           { $cmd .= "    -L$len -l$wid";}


if ($txt) {
  print "--- Suggest '$cmd' on following text ---\n";
  print $head;
  exit;
}


open (P, "|$cmd") or die "Cannot do '$cmd'\n";
print P $head;


###


sub setuppjl {
$prg = "sub dopjl {\n\$pjlret = 0;\n";
$prg .= "while (\$tail =~ s/^(\\\@PJL.{0,200})\\n//) {
  \$pjlret = 1;
  \$c = \$1;			      # Command matched";
if ($txt) {
  $prg .= "
  \$msg = \$c;
  \$msg =~ s/([^ -~])/sprintf \"<X%2.2x>\", ord \$1/eg;
  print \" \$msg\\n\";";
}
  $prg .= "
  if (\$c =~ m/^\\\@PJL\\s+ENTER\\s+LANGUAGE(.*)\$/i) {";
if ($txt) {
  $prg .= "
    print \" Un-recognized (non-PCL) language\\n\" unless \$1 =~ m/^\\s*=\\s*PCL\\s*\$/i;";
}
  $prg .= "
    last;
  }
}
return \$pjlret;
}\n";

#print "#!/usr/bin/perl -w\n\$head=''; \$tail=\"\\\@PJL xyz\n\";dopjl();\n#To eval:\n$prg"; exit;
eval $prg; die "Cannot eval dopjl: $@\n" if $@;
}


###


sub hpg {
  my ($mne, $pat, $msg) = @_;
  $pat = '[0-9. ,+-]*' if $pat eq '1';	# Standard numeric arguments
  $prg .= "
  if (\$tail =~ s/^([\\s,;]*$mne *$pat *;?)//is) {";
  if ($txt) {
    $prg .= "
    \$c = \$1;				# Command matched
    \$msg = '$msg';
    \$msg .= \" \$c\";
    \$msg =~ s/([^ -~])/sprintf \"<X%2.2x>\", ord \$1/eg;
    #if ($mne eq 'PE') { decode command }
    print \" HP-GL \$msg\\n\";";
  }
    $prg .= "
    \$hpgret = 1;
    next;
  }\n";
}

sub setuphpg {
$prg = "sub dohpg {\n\$hpgret = 0;\n";
$prg .= "while (1) {\n";
#$prg .= "\$tail =~ m/^[\\s,;]*([A-Z]?)/is; \$p1 = \"\\u\$1\";\n";
#$prg .= "if (\$p1 eq 'A') {\n";
hpg ('AA', 1,         'Arc abs X Y Sweep Chor');
hpg ('AC', 1,         'Anchor corner X Y     ');
hpg ('AD', 1,         'Alt font Kind Val ... ');
hpg ('AF', 1,         'Advance full page ??  ');
hpg ('AH', 1,         'Advance half page ??  ');
hpg ('AP', 1,         'Auto pen pickup ??    ');
hpg ('AR', 1,         'Arc rel X Y Sweep Chor');
hpg ('AT', 1,         'Arc 3-pt X Y X Y Chord');
#$prg .= "\n}\nelsif (\$p1 eq 'B') {\n";
hpg ('BR', 1,         'Bezier rel X Y X Y ...');
hpg ('BZ', 1,         'Bezier abs X Y X Y ...');
#$prg .= "\n}\nelsif (\$p1 eq 'C') {\n";
hpg ('CA', 1,         'Char set alt Idx      ');
hpg ('CF', 1,         'Char fill Mode Pen    ');
hpg ('CI', 1,         'Circle Radius Chord   ');
hpg ('CO', '"[^"]*"', 'Comment "txt"         ');
hpg ('CP', 1,         'Char plot Spaces Lines');
hpg ('CR', 1,         'Color range R G B ... ');
hpg ('CS', 1,         'Char set std Idx      ');
#$prg .= "\n}\nelsif (\$p1 eq 'D') {\n";
hpg ('DC', '',        'Digitize clear        ');
hpg ('DF', '',        'Defaults              ');
hpg ('DI', 1,         'Dir abs Run Rise      ');
hpg ('DP', '',        'Digitize point        ');
hpg ('DR', 1,         'Dir rel Run Rise      ');
hpg ('DT', '.[01]?',  'Label term Char Mode  ');
hpg ('DV', 1,         'Var txt path Path Line');
#$prg .= "\n}\nelsif (\$p1 eq 'E') {\n";
hpg ('EA', 1,         'Edge rect abs X Y     ');
hpg ('EC', 1,         'Enable cutter ??      ');
hpg ('EP', '',        'Edge polygon          ');
hpg ('ER', 1,         'Edge rect rel X Y     ');
hpg ('ES', 1,         'Extra space Width High');
hpg ('EW', 1,         'Edge wedge R Ang Swe C');
#$prg .= "\n}\nelsif (\$p1 eq 'F') {\n";
hpg ('FI', 1,         'Font primary Idx      ');
hpg ('FN', 1,         'Font secondary Idx    ');
hpg ('FP', 1,         'Fill polygon Method   ');
hpg ('FT', 1,         'Fill type Type ...    ');
#$prg .= "\n}\nelsif (\$p1 eq 'I') {\n";
hpg ('IM', 1,         'Input mask E S P      ');
hpg ('IN', '',        'Initialize            ');
hpg ('IP', 1,         'Input X Y X Y         ');
hpg ('IR', 1,         'IP rel X Y X Y        ');
hpg ('IW', 1,         'IP window X Y X Y     ');
#$prg .= "\n}\nelsif (\$p1 eq 'L') {\n";
hpg ('LA', 1,         'Line attr Kind Val ...');
hpg ('LB', '.*\x03',  'Label Text            ');
hpg ('LO', 1,         'Label origin Pos      ');
hpg ('LT', 1,         'Line type Type Pat Mod');
#$prg .= "\n}\nelsif (\$p1 eq 'M') {\n";
hpg ('MC', 1,         'Merge control On Code ');
#$prg .= "\n}\nelsif (\$p1 eq 'N') {\n";
hpg ('NP', 1,         'Pens in palette Num   ');
#$prg .= "\n}\nelsif (\$p1 eq 'O') {\n";
hpg ('OA', '',        'Output actual pos stat');
hpg ('OC', '',        'Output cmnd pos status');
hpg ('OD', '',        'Output digitzd pos sta');
hpg ('OE', '',        'Output error          ');
hpg ('OF', '',        'Output factors        ');
hpg ('OH', '',        'Output hard-clip limit');
hpg ('OI', '',        'Output identification ');
hpg ('OO', '',        'Output options implmtd');
hpg ('OP', '',        'Output scaling points ');
hpg ('OS', '',        'Output status         ');
hpg ('OW', '',        'Output window         ');
#$prg .= "\n}\nelsif (\$p1 eq 'P') {\n";
hpg ('PA', 1,         'Plot abs X Y ...      ');
hpg ('PC', 1,         'Pen color Pen R G B   ');
hpg ('PD', 1,         'Pen down X Y ...      ');
hpg ('PE', '[^;]*;',  'Polyline encoded Z ...');
hpg ('PG', 1,         'Page eject            ');
hpg ('PM', 1,         'Polygon mode Def      ');
hpg ('PP', 1,         'Pixel placement Mode  ');
hpg ('PR', 1,         'Plot rel X Y ...      ');
hpg ('PS', 1,         'Paper size Size       ');
hpg ('PT', 1,         'Pen thickness MM      ');
hpg ('PU', 1,         'Pen up X Y ...        ');
hpg ('PW', 1,         'Pen width Width Pen   ');
#$prg .= "\n}\nelsif (\$p1 eq 'R') {\n";
hpg ('RA', 1,         'Fill rect abs X Y     ');
hpg ('RF', 1,         'Raster fill Idx W H P.');
hpg ('RO', 1,         'Rotate degrees        ');
hpg ('RP', '',        'Replot                ');
hpg ('RR', 1,         'Fill rect rel X Y     ');
hpg ('RT', 1,         'Arc 3-pt rel X Y X Y C');
#$prg .= "\n}\nelsif (\$p1 eq 'S') {\n";
hpg ('SA', '',        'Select alternate font ');
hpg ('SB', 1,         'Bitmap font Allow     ');
hpg ('SC', 1,         'Scale X X Y Y Type ...');
hpg ('SD', 1,         'Std font Kind Val ... ');
hpg ('SI', 1,         'Char size Width Height');
hpg ('SL', 1,         'Char slant Tan-of-angl');
hpg ('SM', '[^;]',    'Symbol mode Char      ');
hpg ('SP', 1,         'Select pen Pen        ');
hpg ('SR', 1,         'Char size rel Wid Hi  ');
hpg ('SS', '',        'Select standard font  ');
hpg ('SV', 1,         'Screen vect Type ...  ');
#$prg .= "\n}\nelsif (\$p1 eq 'T') {\n";
hpg ('TD', 1,         'Transp data Mode      ');
hpg ('TL', 1,         'Tick length TP TN     ');
hpg ('TR', 1,         'Transp mode Mode      ');
#$prg .= "\n}\nelsif (\$p1 eq 'U') {\n";
hpg ('UC', 1,         'Usr-def char Ctl X Y..');
hpg ('UL', 1,         'Usr-def line Idx ...  ');
#$prg .= "\n}\nelsif (\$p1 eq 'V') {\n";
hpg ('VA', 1,         'Adaptive velocity ??  ');
hpg ('VN', 1,         'Normal velocity ??    ');
hpg ('VS', 1,         'Velocity select V     ');
#$prg .= "\n}\nelsif (\$p1 eq 'W') {\n";
hpg ('WG', 1,         'Fill wedge R Ang Swe C');
hpg ('WU', 1,         'Pen width unit Type   ');
#$prg .= "\n}\nelsif (\$p1 eq 'X') {\n";
hpg ('XT', '',        'X-tick                ');
#$prg .= "\n}\nelsif (\$p1 eq 'Y') {\n";
hpg ('YT', '',        'Y-tick                ');
#$prg .= "\n}\n";
hpg ('[A-Z][A-Z]', 1, 'Un-recognized         ');

if ($txt) {
  $prg .= "
  (\$z) = (\$tail =~ m/^(.{1,20})/s);
  \$z = '' unless defined \$z and \$z !~ /^\\e/;
  \$z =~ s/([^ -~])/sprintf \"<X%2.2x>\", ord \$1/eg;
  print \" HP-GL  stumped before \$z\\n\" if \$z ne '';\n";
}
$prg .= "  last;\n";
$prg .= "}\nreturn \$hpgret;\n}\n";

#print "#!/usr/bin/perl -w\n\$head=''; \$tail=\"PUXY\";dohpg();\n#To eval:\n$prg"; exit;
eval $prg; die "Cannot eval dohpg: $@\n" if $@;
}


###


sub pcl {
  my ($pat, $hsh, $xtr, $var, $msg, $exc) = @_;
  $pat =~ s/^([\&\(\)\*\.])/\\$1/;	# Escape perl metacharacters
  $pat =~ s/#/$hsh/;			# Substitute pattern for '#' value
  $prg .= "
  if (\$tail =~ s/^($pat)//s) {";
  if ($txt) {
    $prg .= "
    \$c = \$1;				# Command matched";
  }
  if ($txt or $xtr or $var) {
    $prg .= "
    \$x = \$2; \$x .= \$3 if defined \$3;	# Numeric '#' value, maybe others
    \$x = '0' unless defined \$x and \$x ne '';	# Assume 0 for missing value";
  }
  if ($xtr) {				# Skip a few bytes
    $prg .= "
    \$tail =~ s/^(.{0,\$x})//s;";
  if ($txt) {
    $prg .= "
    \$z = length(\$1);";
  if ($xtr > 1) {
    $prg .= "
    \$z = \"= \$1 : \$z\";";
  }
  }
  }
  if ($var) {				# Set $$var if needed
    $prg .= "
    \${$var} = \$x;";
  }
  if ($txt) {
    $prg .= "
    \$msg = '$msg';
    \$msg =~ s/xx/\$x/;
    \$msg .= \" <ESC>\$c\";";
  if ($xtr) {
    $prg .= "
    \$msg .= \" (\$z bytes skipped)\" if \$z ne '';";
  }
    $prg .= "
    (\$z) = (\$tail =~ m/^(.{1,20})/s);
    \$z = '' unless defined \$z and \$z !~ /^\\e/;
    \$msg .= \" (before \$z)\" if \$z ne '';
    \$msg =~ s/([^ -~])/sprintf \"<X%2.2x>\", ord \$1/eg;";
  if ($var) {
    $prg .= "
    print \"+\$msg\\n\";";
  }
  else {
    $prg .= "
    print \" \$msg\\n\";";
  }
  }
  if (defined $exc and $exc ne '') {
    $prg .= "
    $exc;";
  }
    $prg .= "
    next;
  }";
  # Check for space-saving ESC sequence combinations
  $prg .= "\n", return if $xtr;
  $prg .= "\n", return unless $pat =~ s/^(\\[\&\(\)\*][a-z])(.*)([A-Z])$/$1$2\l$3/;
  $x = $1;
  $x =~ s/\\//g;
  1 while $pat =~ s/([^\\]\()([^?])/$1?:$2/g;
  $pat =~ s/^(.*)(.)/($1)($2)/;
  $prg .= "
  if (\$tail =~ s/^$pat/\\e\$1\\u\$2\\e$x/s) {";
  if ($txt) {
    $prg .= "
    \$y = \$1; \$z = \$2;
    \$msg = '$msg';
    \$msg =~ s/xx.*//;
    \$msg =~ s/./ /g;
    \$msg =~ s/\$/Space-saver <ESC>\$y\$z expanded to <ESC>\$y\\u\$z<ESC>$x/;
    print \" \$msg\\n\";";
  }
  if (defined $exc and $exc ne '') {
    $prg .= "
    $exc;";
  }
    $prg .= "
    next;
  }\n";
}

sub setuppcl {
# Numeric values for '#' (must be parenthesised)
$I='(\d*)';				# Integer (unsigned)
$Z='([+-]?\d*)';			# Zigned integer
$D='(\d*|\d+\.\d*|\d*\.\d+)';		# Decimal (unsigned)
$R='([+-]?(?:\d*|\d+\.\d*|\d*\.\d+))';	# Real (signed decimal)

$prg = "sub dopcl {\n\$pclret = 0;\n";
$prg .= "while (\$tail =~ s/^\\e//) {\n\$pclret = 1;\n";
$prg .= "(\$p1,\$p2) = (\$tail =~ m/^(.?)(.?)/);\n";
$prg .= "if (\$p1 eq '%') {\n";
pcl ('%#A', $I, 0, '',   'Enter PCL mode:         xx (0=use PCL position, 1=use HP-GL position)');
pcl ('%#B', $I, 0, '',   'Enter HP-GL mode:       xx (0=use HP-GL position, 1=use PCL position)', 'dohpg()');
pcl ('%#X', $Z, 0, '',   'Universal Exit Language xx (-12345=PJL)', 'dopjl()');
$prg .= "\n}\nif (\$p1 eq '&') {\n";
$prg .= " if (\$p2 eq 'a') {\n";
pcl ('&a#C',$I, 0, '',   'Horizontal position:    xx (columns)');
pcl ('&a#G',$I, 0, '',   'Page side selection:    xx (0=next, 1=front, 2=next)');
pcl ('&a#H',$Z, 0, '',   'Horizontal position:    xx (decipoints)');
pcl ('&a#L',$I, 0, '',   'Left margin:            xx (chars)');
pcl ('&a#M',$I, 0, '',   'Right margin:           xx (chars)');
pcl ('&a#P',$I, 0, '',   'Print direction:        xx (degrees of rotation)');
pcl ('&a#R',$R, 0, '',   'Vertical position:      xx (rows)');
pcl ('&a#V',$Z, 0, '',   'Vertical position:      xx (decipoints)');
$prg .= "\n }\n elsif (\$p2 eq 'b') {\n";
pcl ('&b#M',$I, 0, '',   'Monochrome print mode   xx (0=MixedRender, 1=GrayScale)');
$prg .= "\n }\n elsif (\$p2 eq 'c') {\n";
pcl ('&c#T',$Z, 0, '',   'Text path direction:    xx (0=horizontal, -1=vertical rotated)');
$prg .= "\n }\n elsif (\$p2 eq 'd') {\n";
pcl ('&d#D',$I, 0, '',   'Enable underline:       xx (0=Fixed, 3=Floating)');
pcl ('&d@', '', 0, '',   'Disable underline      ');
$prg .= "\n }\n elsif (\$p2 eq 'f') {\n";
pcl ('&f#S',$I, 0, '',   'Push/pop position:      xx (0=push, 1=pop)');
pcl ('&f#X',$I, 0, '',   'Macro control:          xx (0=Start, 1=Stop, 2=Exec, 3=Call, 4=EnableOverlay, 5=DisableOverlay, 6=DelAll, 7=DelTemp, 8=DelID, 9=MkTemp, 10=MkPerm)');
pcl ('&f#Y',$I, 0, '',   'Macro ID:               xx');
$prg .= "\n }\n elsif (\$p2 eq 'k') {\n";
pcl ('&k#G',$I, 0, '',   'Line termination:       xx (0=natural, 1=cr>cr+lf, 2=lf>cr+lf,ff>cr+lf, 3=cr>cr+lf,lf>cr+lf,ff>cr+ff)');
pcl ('&k#H',$I, 0, '',   'Horiz Motion Index:     xx (1/120inch)');
pcl ('&k#S',$I, 0, '',   'Spacing:                xx (0=10cpi, 2=16.6cpi, 4=12cpi)');
pcl ('&k#W',$I, 0, '',   'Text print mode:        xx (0=left-to-right, 1=bi-directional, 2=right-to-left, 5=text scale disable, 6=text scale enable)');
$prg .= "\n }\n elsif (\$p2 eq 'l') {\n";
pcl ('&l#A',$I, 0, '',   'Paper size:             xx (0=default, 1=Executive, 2=Letter, 3=Legal, 26=A4, 100=B5, 80=Monarch, 81=COM10, 90=DL, 91=C5, 101=Custom)');
pcl ('&l#C',$I, 0, '',   'Vertical Motion Index:  xx (1/120inch)');
pcl ('&l#D',$I, 0, '',   'Lines per inch:         xx');
pcl ('&l#E',$I, 0, '',   'Top margin:             xx (lines)');
pcl ('&l#F',$I, 0, 'len','Text length:            xx (lines)');
pcl ('&l#G',$I, 0, '',   'Paper destination:      xx (0=auto, 1=top bin, 2=left bin and others)');
pcl ('&l#H',$I, 0, '',   'Paper feed:             xx (0=Eject, 1=Cassette, 2=Manual, 3=Envelope)');
pcl ('&l#L',$I, 0, '',   'Perforation skip:       xx (0=Disable, 1=Enable)');
pcl ('&l#M',$I, 0, '',   'Media type:             xx (0=plain, 1=bond, 2=premier, 3=glossy film, 4=transparency)');
pcl ('&l#O',$I, 0, 'ori','Orientation:            xx (0=Portrait, 1=Landscape)');
pcl ('&l#P',$I, 0, '',   'Page length:            xx (lines)');
pcl ('&l#S',$I, 0, '',   'Duplex mode:            xx (0=Simplex, 1=Duplex long edge binding, 2=Duplex short edge binding)');
pcl ('&l#T',$I, 0, '',   'Stacking position:      xx (0=Default, 1=Alternate)');
pcl ('&l#U',$Z, 0, '',   'Long-edge offset:       xx (decipoints)');
pcl ('&l#X',$I, 0, '',   'Number of copies:       xx');
pcl ('&l#Z',$Z, 0, '',   'Short-edge offset:      xx (decipoints)');
$prg .= "\n }\n elsif (\$p2 eq 'n') {\n";
pcl ('&n#W',$I, 2, '',   'Paper type:             xx (bytes)');
$prg .= "\n }\n elsif (\$p2 eq 'p') {\n";
pcl ('&p#C',$I, 0, '',   'Palette control         xx (0=DeleteNonStack, 1=DeleteStack, 2=DeleteCurr, 6=CopyActive');
pcl ('&p#I',$I, 0, '',   'Palette control ID      xx');
pcl ('&p#S',$I, 0, '',   'Select palette          xx');
pcl ('&p#X',$I, 1, '',   'Transparent print:      xx (bytes)');
$prg .= "\n }\n elsif (\$p2 eq 'r') {\n";
pcl ('&r#F',$I, 0, '',   'Flush pages:            xx (0=Complete, 1=All)');
$prg .= "\n }\n elsif (\$p2 eq 's') {\n";
pcl ('&s#C',$I, 0, '',   'Wrap-around mode:       xx (0=Enable, 1=Disable)');
$prg .= "\n }\n elsif (\$p2 eq 't') {\n";
pcl ('&t#P',$I, 0, '',   'Text parsing method:    xx (0,1=one-byte chars, 21=two-byte Asian 7-bit chars, 31=two-byte Shift JIS chars, 38=two-byte Asian 8-bit chars)');
$prg .= "\n }\n elsif (\$p2 eq 'u') {\n";
pcl ('&u#D',$I, 0, '',   'Unit of measure:        xx (per inch)');
$prg .= "\n }";
$prg .= "\n}\nif (\$p1 eq '(') {\n";
pcl ('(#@', $I, 0, '',   'Primary font default:   xx (0,1=Default, 2=Closest, 3=AllCharact)');
pcl ('(#W', $I, 1, '',   'Define symbol set:      xx (bytes)');
pcl ('(#X', $I, 0, '',   'Primary font:           xx (ID)');
pcl ('(#([A-Z])',$I,0,'','Primary symbol set:     xx (0N=ISO 8859-1 and many more)');
pcl ('(f#W',$I, 1, '',   'Define symbol set:      xx (bytes)');
pcl ('(s#B',$Z, 0, '',   'Primary stroke weight:  xx');
pcl ('(s#H',$D, 0, 'cpi','Primary chars per inch: xx');
pcl ('(s#P',$I, 0, '',   'Primary spacing:        xx (0=Fixed, 1=Proportional)');
pcl ('(s#Q',$I, 0, '',   'Primary print quality:  xx (1=Draft, 2=Letter)');
pcl ('(s#S',$I, 0, '',   'Primary style :         xx (0=Upright, 1=Italic, 4=Condense, 8=Compress, 24=Expand, 32=Outline, 64=Inline, 128=Shadow)');
pcl ('(s#T',$I, 0, '',   'Primary typeface:       xx (various codes)');
pcl ('(s#V',$D, 0, '',   'Primary height:         xx (points)');
pcl ('(s#W',$I, 1, '',   'Download char:          xx (bytes)');
$prg .= "\n}\nif (\$p1 eq ')') {\n";
pcl (')#@', $I, 0, '',   'Secondary font def:     xx (0=Default, 1=DefPrimary, 2=CurrPrimary, 3=AllCharact)');
pcl (')#X', $I, 0, '',   'Secondary font:         xx (ID)');
pcl (')#([A-Z])',$I,0,'','Secondary symbol set:   xx (0N=ISO 8859-1 and many more)');
pcl (')s#B',$Z, 0, '',   'Secondary stroke wght:  xx');
pcl (')s#H',$D, 0, 'cpi','Secondary chars/inch:   xx');
pcl (')s#P',$I, 0, '',   'Secondary spacing:      xx (0=Fixed, 1=Proportional)');
pcl (')s#Q',$I, 0, '',   'Secondary print qualty: xx (1=Draft, 2=Letter)');
pcl (')s#S',$I, 0, '',   'Secondary style :       xx (0=Upright, 1=Italic, 4=Condense, 8=Compress, 24=Expand, 32=Outline, 64=Inline, 128=Shadow)');
pcl (')s#T',$I, 0, '',   'Secondary typeface:     xx (various codes)');
pcl (')s#V',$D, 0, '',   'Secondary height:       xx (points)');
pcl (')s#W',$I, 1, '',   'Font header text:       xx (bytes)');
$prg .= "\n}\nif (\$p1 eq '*') {\n";
$prg .= " if (\$p2 eq 'b') {\n";
pcl ('*b#M',$I, 0, '',   'Raster compress:        xx (0=Unencoded, 1=Run-Length, 2=TIFF, 3=DeltaFlow, 5=AdaptComp)');
pcl ('*b#S',$I, 0, '',   'Raster seed row source  xx');
pcl ('*b#V',$I, 1, '',   'Raster data by plane:   xx (bytes)');
pcl ('*b#W',$I, 1, '',   'Raster data:            xx (bytes)');
pcl ('*b#Y',$I, 0, '',   'Raster Y offset:        xx');
$prg .= "\n }\n elsif (\$p2 eq 'c') {\n";
pcl ('*c#A',$I, 0, '',   'Rectangle width:        xx (dots)');
pcl ('*c#B',$I, 0, '',   'Rectangle height:       xx (dots)');
pcl ('*c#D',$I, 0, '',   'Font ID:                xx');
pcl ('*c#E',$I, 0, '',   'Font char code:         xx');
pcl ('*c#F',$I, 0, '',   'Font control:           xx (0=DelAll, 1=DelTemp, 2=DelCurr, 3=DelChar, 4=MkTemp, 5=MkPerm, 6=CpTemp)');
pcl ('*c#G',$I, 0, '',   'Pattern:                xx (% of gray, or crosshatch style, or ID)');
pcl ('*c#H',$I, 0, '',   'Rectangle width:        xx (decipoints)');
pcl ('*c#K',$I, 0, '',   'Horizontal HP-GL size   xx');
pcl ('*c#L',$I, 0, '',   'Vertical HP-GL size     xx');
pcl ('*c#P',$I, 0, '',   'Fill rectangle:         xx (0=Black, 1=White, 2=Shade, 3=CrossHatch, 4=UserPatt, 5=CurrPatt)');
pcl ('*c#Q',$I, 0, '',   'Pattern control:        xx (0=DelAll, 1=DelTemp, 2=DelCurr, 4=MkTemp, 5=MkPerm)');
pcl ('*c#R',$I, 0, '',   'Symbol set ID:          xx');
pcl ('*c#S',$I, 0, '',   'Symbol set control:     xx (0=DelAll, 1=DelTemp, 2=DelCurr, 4=MkTemp, 5=MkPerm)');
pcl ('*c#T',$I, 0, '',   'Pict frame anchor point xx (0=AtCurrCursorPos)');
pcl ('*c#V',$I, 0, '',   'Rectangle height:       xx (decipoints)');
pcl ('*c#W',$I, 1, '',   'Define pattern:         xx (bytes)');
pcl ('*c#X',$D, 0, '',   'Pict frame horiz size   xx');
pcl ('*c#Y',$D, 0, '',   'Pict frame vert size    xx');
$prg .= "\n }\n elsif (\$p2 eq 'd') {\n";
pcl ('*d#W',$I, 1, '',   'Palette configuration   xx (bytes)');
$prg .= "\n }\n elsif (\$p2 eq 'g') {\n";
pcl ('*g#W',$I, 0, '',   'Configure raster data   xx (??)');
$prg .= "\n }\n elsif (\$p2 eq 'i') {\n";
pcl ('*i#W',$I, 1, '',   'Viewing illuminant      xx (bytes)');
$prg .= "\n }\n elsif (\$p2 eq 'l') {\n";
pcl ('*l#O',$I, 0, '',   'ROP Logical operation   xx');
pcl ('*l#R',$I, 0, '',   'Pixel placement         xx (0=GridIntersection, 1=GridCentered)');
pcl ('*l#W',$I, 1, '',   'Colour lookup table     xx (bytes)');
$prg .= "\n }\n elsif (\$p2 eq 'm') {\n";
pcl ('*m#W',$I, 1, '',   'Download dither matrix  xx (bytes)');
$prg .= "\n }\n elsif (\$p2 eq 'o') {\n";
pcl ('*o#D',$I, 0, '',   'Raster depletion:       xx');
pcl ('*o#Q',$I, 0, '',   'Raster shingling:       xx');
pcl ('*o#W',$I, 1, '',   'Driver configuration    xx (bytes)');
$prg .= "\n }\n elsif (\$p2 eq 'p') {\n";
pcl ('*p#N',$I, 0, '',   'Print mode (graphics):  xx (0=Default, 1=Bidirectional, 2=Left to Right, 3=Right to Left, 4=Conditional bidirectional)');
pcl ('*p#P',$I, 0, '',   'Push/pop palette        xx (0=Push/Save, 1=Pop/Restore)');
pcl ('*p#Q',$I, 0, '',   'Pattern control:        xx (0=DelAll, 1=DelTemp, 2=DelCurr, 4=MkTemp, 5=MkPerm)');
pcl ('*p#R',$I, 0, '',   'Rotate pattern:         xx (0=WithOrient, 1=PhysPage)');
pcl ('*p#X',$Z, 0, '',   'Horizontal position:    xx (dots)');
pcl ('*p#Y',$Z, 0, '',   'Vertical position:      xx (dots)');
$prg .= "\n }\n elsif (\$p2 eq 'r') {\n";
pcl ('*r#A',$I, 0, '',   'Start raster graphics:  xx (0=AtLeftMargin, 1=AtCurrCursor)');
pcl ('*rB', '', 0, '',   'End raster graphics (old version?) ');
pcl ('*rC', '', 0, '',   'End raster graphics    ');
pcl ('*r#F',$I, 0, '',   'Raster orientation:     xx (0=Orient, 3=PhysPage)');
pcl ('*r#Q',$I, 0, '',   'Raster quality:         xx (1=draft, 2=similar to letter)');
pcl ('*r#S',$I, 0, '',   'Raster width:           xx');
pcl ('*r#T',$I, 0, '',   'Raster height:          xx');
pcl ('*r#U',$Z, 0, '',   'Raster planes per row:  xx (1=single, -3=CMY, 3=RGB, -4=KCMY)');
$prg .= "\n }\n elsif (\$p2 eq 's') {\n";
pcl ('*s#F',$I, 0, '',   'Flush pages:            xx (0=Complete, 1=All)');
pcl ('*s#I',$I, 0, '',   'Inquire status:         xx (0=Font, 1=Macro, 2=UserPattern, 3=SymbolSet, 4=FontExtended)');
pcl ('*s#M',$I, 0, '',   'Inquire memory:         xx (1=FreeSpace)');
pcl ('*s#T',$I, 0, '',   'Status location:        xx (0=Invalid, 1=CurrSelect, 2=AllLoc, 3=Intern, 4=Download, 5=Cartr, 7=User)');
pcl ('*s#U',$I, 0, '',   'Status locator:         xx (0=all)');
pcl ('*s#X',$Z, 0, '',   'Echo value:             xx');
$prg .= "\n }\n elsif (\$p2 eq 't') {\n";
pcl ('*t#H',$I, 0, '',   'Dest raster width       xx (decipoints)');
pcl ('*t#I',$D, 0, '',   'Gamma correction:       xx');
pcl ('*t#J',$I, 0, '',   'Rendering algorithm     xx (0=NearestIntensity, 3,5=DeviceBest, 4,6=ErrorDiffusion)');
pcl ('*t#K',$I, 0, '',   'Scale algorightm        xx (0=Light, 1=Dark background)');
pcl ('*t#R',$I, 0, '',   'Raster resolution:      xx (dots/inch)');
pcl ('*t#V',$I, 0, '',   'Dest raster height      xx (decipoints)');
$prg .= "\n }\n elsif (\$p2 eq 'v') {\n";
pcl ('*v#A',$R, 0, '',   'Color component one     xx');
pcl ('*v#B',$R, 0, '',   'Color component two     xx');
pcl ('*v#C',$R, 0, '',   'Color component three   xx');
pcl ('*v#I',$I, 0, '',   'Assign color index      xx');
pcl ('*v#N',$I, 0, '',   'Source transp:          xx (0=Transparent, 1=Opaque)');
pcl ('*v#O',$I, 0, '',   'Pattern transp:         xx (0=Transparent, 1=Opaque)');
pcl ('*v#S',$I, 0, '',   'Color text foreground:  xx');
pcl ('*v#T',$I, 0, '',   'Pattern:                xx (0=Black, 1=White, 2=Shade, 3=CrossHatch, 4=UserPatt)');
pcl ('*v#W',$I, 1, '',   'Configure image data    xx (bytes)');
$prg .= "\n }";
$prg .= "\n}\nif (\$p1 eq '.') {\n";
pcl ('.\(', '', 0, '',   'RS232 Plotter on            ');
pcl ('.\)', '', 0, '',   'RS232 Plotter off           ');
pcl ('.@[^:]*:','',0,'', 'RS232 Plotter config (bufsiz and DTR/CD line control)');
pcl ('.B',  '', 0, '',   'RS232 Output buffer space   ');
pcl ('.E',  '', 0, '',   'RS232 Output extended error ');
pcl ('.H[^:]*:','',0,'', 'RS232 Set handshake mode1   ');
pcl ('.I[^:]*:','',0,'', 'RS232 Set handshake mode2   ');
pcl ('.J',  '', 0, '',   'RS232 Abort device control  ');
pcl ('.K',  '', 0, '',   'RS232 Abort graphic instruct');
pcl ('.L',  '', 0, '',   'RS232 Output buffer size    ');
pcl ('.M[^:]*:','',0,'', 'RS232 Output mode           ');
pcl ('.N[^:]*:','',0,'', 'RS232 Extended output and handshake mode');
pcl ('.O',  '', 0, '',   'RS232 Output extended status');
pcl ('.R',  '', 0, '',   'RS232 Reset handshake       ');
pcl ('.Y',  '', 0, '',   'RS232 Plotter on            ');
pcl ('.Z',  '', 0, '',   'RS232 Plotter off           ');
$prg .= "\n}\n";

pcl ('9',   '', 0, '',   'Clear horiz margins    ');
pcl ('=',   '', 0, '',   'Half line feed         ');
pcl ('E',   '', 0, '',   'Reset                  ');
pcl ('Y',   '', 0, '',   'Display functions on   ');
pcl ('Z',   '', 0, '',   'Display functions off  ');
pcl ('z',   '', 0, '',   'SelfTest               ');

pcl ('\[r', '', 0, '',   'Start-bold ??          ');
pcl ('\[u', '', 0, '',   'Stop-bold ??           ');
pcl ('[ -~]*?[A-Z]','',0,'','Un-recognized (skipped)');
pcl ('[ -~]*?[a-z]','',0,'','Un-recognized (skipped)');

if ($txt) {
  $prg .= "
  (\$z) = (\$tail =~ m/^(.{1,20})/s);
  \$z = '' unless defined \$z;
  \$z =~ s/([^ -~])/sprintf \"<X%2.2x>\", ord \$1/eg;
  print \" Bad escape sequence <X1b>\$z\\n\";\n";
}
$prg .= "  \$head .= '<X1b>';\n";

$prg .= "}\nreturn \$pclret;\n}\n";

#print "#!/usr/bin/perl -w\n\$head=''; \$tail=\"\\eabc\";dopcl();\n#To eval:\n$prg"; exit;
eval $prg; die "Cannot eval dopcl: $@\n" if $@;
}

exit;	# Just in case...

###

# Man page (should not really be part of the script),
# put this into /usr/local/man/man1/pcl2ps.1 or similar.
# 
# .\" This manpage source uses rsml coding. (Foolishly copying DEC stuff...)
# .so /usr/share/lib/tmac/sml
# .so /usr/share/lib/tmac/rsml
# .TH pcl2ps 1
# .SH NAME
# .PP
# \*Lpcl2ps\*O, \*Lpcl2txt\*O, \*Lhpgl2txt\*O \- Simple PCL to PostScript converter
# .SH SYNOPSIS
# \*Lpcl2ps\*O
# \*O[\*Vfile\*O]
# .PP
# \*Lpcl2txt\*O
# \*O[\*Vfile\*O]
# .PP
# \*Lhpgl2txt\*O
# \*O[\*Vfile\*O]
# .PP
# .SH DESCRIPTION
# Use \*Lpcl2ps\*O to convert a simple PCL (Hewlett-Packard \*LP\*Orinter
# \*LC\*Oontrol \*LL\*Oanguage) file and show the PostScript translation on
# stdout; use \*Lpcl2txt\*O as a kind of debug option. Use \*Lhpgl2txt\*O
# to debug HP-GL (Hewlett-Packard \*LG\*Oraphics \*LL\*Oanguage) files.
# .PP
# Look directly in the (short) \fBperl\fR(1) script for further info.
# .PP