[alt.sources] PostScript to troff converter for Perl Reference Guide

jv@mh.nl (Johan Vromans) (06/13/90)

This perl program translates the PostScript output for the Perl
Reference Guide to troff. It may be useful for other things as well.

NOTE:	This program was sent to me by Barry Friedman
	<uunet!chekov!friedman>. You should contact him for details
	and remarks. I'm only passing it through.

Submitted-by: Barry Friedman <uunet!chekov!friedman>
Archive-name: tguide/part01

---- Cut Here and unpack ----
#!/bin/sh
# This is tguide, a shell archive (shar 3.24)
# made 06/13/1990 08:19 UTC by jv@squirrel.mh.nl
# Source directory /u/jv/reftf
#
# existing files WILL be overwritten
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#   3160 -rwxrwxrwx tguide
#
if touch 2>&1 | fgrep '[-amc]' > /dev/null
 then TOUCH=touch
 else TOUCH=true
fi
# ============= tguide ==============
echo "x - extracting tguide (Text)"
sed 's/^X//' << 'SHAR_EOF' > tguide &&
X#!/utils/bin/perl
X$em='\\\\(em';  #  em dash
X$dg='\\\\(dg';  #  dagger
X#   scale and page position factors
X$hscale=3;
X$vscale=2.7;
X$hcorr=250;
X$vcorr=120;
X
X#  this sequence works with Eroff, don't know about others
Xprint q|\X'code="\e033&l2S"'\c|,"\n";  #  laserjet 2000 control sequence
X
Xprint ".po 0\n";
Xprint ".in 0\n";
X
Xwhile (<>) {
X
X	#-------------------------------------------------
X	# Skip a lot of useless stuff
X	#-------------------------------------------------
X
X	if ( /^%%/ ) { # comments skipped
X		next;
X	}
X
X	if ( / gr$/ ) {  
X		#?
X		next;
X	}
X
X	if ( / lw$/ ) {  
X		#?
X		next;
X	}
X
X	if ( / lin$/ ) {  
X		#?
X		next;
X	}
X
X	if ( / setTxMode$/ ) {  
X		#?
X		next;
X	}
X
X	if ( / pen$/ ) {  
X		#?
X		next;
X	}
X
X	if ( /\)kp$/ ) {  
X		#frame ?
X		next;
X	}
X
X	if ( / xl$/ ) {  
X		#frame ?
X		next;
X	}
X
X	if ( / fr$/ ) {  
X		#frame ?
X		next;
X	}
X
X	if ( /bu fc$/ ) {
X		next;
X	}
X
X	if ( /fs$/ ) {
X		next;
X	}
X
X	if ( /bn$/ ) {
X		next;
X	}
X	#-------------------------------------------------
X	# Now for some real work
X	#-------------------------------------------------
X
X	if ( /^move1$/ ) {  # output page NOTE: Eroff 2-up landscape handles
X											# this automatically  - otherwise toggle a correction
X											# factor to be added to horizontal position
X		#move to left side of page
X		next;
X	}
X
X	if ( /^move2$/ ) {  # output page
X		#move to right side of page
X		next;
X	}
X
X	if ( /^op$/ ) {  # output page
X		print ".bp\n";
X		next;
X	}
X
X	#-------------------------------------------------
X	# Font Changes
X	#-------------------------------------------------
X
X	if ( /Helvetica fnt/ ) {
X		print "'ft H\n";
X		next;
X	}
X
X	if ( /Times-Bold fnt/ ) {
X		print ".ft B\n";
X		next;
X	}
X
X	if ( /Times-Italic fnt/ ) {
X		print ".ft I\n";
X		next;
X	}
X	if ( /Times-Roman fnt/ ) {
X		print ".ft R\n";
X		next;
X	}
X	#-------------------------------------------------
X	# Size translations (from 2up guide 
X	#-------------------------------------------------
X	if ( /(\d+) fz/ ) {
X		$sz = $1;
X		if ($sz == 24) { $sz = 18; } 
X		elsif ($sz == 18) { $sz = 12; } 
X		elsif ($sz == 14) { $sz = 10; } 
X		elsif ($sz == 12) { $sz = 8; } 
X		elsif ($sz == 10) { $sz = 8; } 
X
X		print ".ps $sz\n";
X		$vs = $sz+2;
X		print ".vs $vs\n";
X		next;
X	}
X	#-------------------------------------------------
X	# Positioning
X	#-------------------------------------------------
X	if ( /(-*\d+) (-*\d+) gm$/ ) {
X		$v= $1; # vertical pos
X		$h= $2; # horiz. pos
X		if ($1 < 0 || $2 < 0 ) {
X			next;
X		}
X		$sc_v = int($v * $vscale) - $vcorr;
X		print ".br\n";
X		print ".sp |$sc_v","u\n";
X		$sc_h = int($h * $hscale) - $hcorr;
X		print "\\h\'|$sc_h","u\'\\c\n";
X		next;
X	}
X	#-------------------------------------------------
X	# Text translations
X	#-------------------------------------------------
X	if ( /[(](.*)[)].*show$/ ) {
X		$ln = $1;
X		$ln =~ s/\\240/$dg/g; 
X		$ln =~ s/\\253/'/g; 
X		$ln =~ s/\\311/.../g; 
X		$ln =~ s/\\312/\\|/g; 
X		$ln =~ s/\\322/``/g; 
X		$ln =~ s/\\323/''/g; 
X		$ln =~ s/\\325/'/g; 
X		$ln =~ s/\\32./$em/g; 
X
X		$ln =~ s/\\\(/\(/g;
X		$ln =~ s/\\\)/\)/g;
X		# guard column 1 of output
X		if ( $ln =~ /^[.'" ]/ ) {
X			$ln = "\\&" . $ln;
X		}
X		print "$ln\n";
X		next;
X	}
X	print STDERR "?: $_\n";  # Anything I missed
X}
SHAR_EOF
$TOUCH -am 0531181990 tguide &&
chmod 0777 tguide ||
echo "restore of tguide failed"
set `wc -c tguide`;Wc_c=$1
if test "$Wc_c" != "3160"; then
	echo original size 3160, current size $Wc_c
fi
exit 0
--
Johan Vromans				       jv@mh.nl via internet backbones
Multihouse Automatisering bv		       uucp: ..!{uunet,hp4nl}!mh.nl!jv
Doesburgweg 7, 2803 PL Gouda, The Netherlands  phone/fax: +31 1820 62944/62500
------------------------ "Arms are made for hugging" -------------------------