Source Code 1992 March/Source_Code_CD-ROM_Walnut_Creek_March_1992.iso/usenet/altsrcs/1/1454

Internet Message Format | 1990-12-28 | 4.9 KB

From: [e-mail] (Johan Vromans)
Newsgroups: comp.lang.perl,alt.sources
Subject: PostScript to troff converter for Perl Reference Guide
Message-ID: <[e-mail]>
Date: 13 Jun 90 16:26:16 GMT
X-Checksum-Snefru: 0ec8fdec 0428230e f908f43e b8760a7d

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 [e-mail]
# 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                       [e-mail] via internet backbones
Multihouse Automatisering bv               uucp: ..!{uunet,hp4nl}!mh.nl!jv
Doesburgweg 7, 2803 PL Gouda, The Netherlands  phone/fax: [phone]/62500
------------------------ "Arms are made for hugging" -------------------------